绿色版OFFICE的文件关联

UID

'如果文件名不一样，稍微有点编程知识的人看看应该就知道怎么改了，关键变量就是APPToLink和APPLength

'关联多种文件类型示例
Function GetPath
    '' Retrieve path to the script file
    Dim path
    path = WScript.ScriptFullName  '' Script file name
    GetPath = Left(path, InstrRev(path, "\")-1)
End Function


Dim WSHShell,APPToLink,CurAPP,APPLength,TypeToLink(3),CurType,TypeLength,HowTo

HowTo = MsgBOX("将要设置Office文件用本目录应用程序打开",vbOKCancel)
IF HowTo = vbOK Then

Set WSHShell = WScript.CreateObject("WScript.Shell")

APPToLink = "EXCEL   MSACCESSPOWERPNTWINWORD"    '设置所有应用程序
CurAPP = vbNullString
APPLength = 8                                    '应用程序名长度

TypeToLink(0) = "XLSXLTXLAXLCXLWCSVXLMXLLXLBSLK"     '设置支持的文件类型
TypeToLink(1) = "MDBADPMDAMDEADEMDWDBF"
TypeToLink(2) = "PPTPPSPOTPPA"
TypeToLink(3) = "DOCDOTRTFWRI"
TypeLength = 3                    '扩展名长度

'循环各应用程序
J=0
Do While J<=UBound(TypeToLink)     '不超过数组维数
CurAPP=Trim(Mid(APPToLink,J*APPLength+1,APPLength))
CurType = vbNullString

'以下循环注册各个文件的右键菜单
I=1
  Do 'While TypeToLink(J).Length\TypeLength>=I
  CurType=Trim(Mid(TypeToLink(J),(I-1)*TypeLength+1,TypeLength))
  IF CurType=vbNullString Then Exit Do
  WSHShell.RegWrite "HKCR\."&CurType&"\",CurType&"file"
  WSHShell.RegWrite "HKCR\"&CurType&"file\DefaultIcon\",Chr(34)&GetPath()&"\"&CurAPP&".EXE"&Chr(34)&",0","REG_EXPAND_SZ"
  WSHShell.RegWrite "HKCR\"&CurType&"file\shell\open\command\",Chr(34)&GetPath()&"\"&CurAPP&".EXE"&Chr(34)&SPACE(1)&Chr(34)&"%1"&Chr(34),"REG_SZ"
  I=I+1
  Loop

J=J+1
Loop

'因为目录中很可能有空格,会被解释为多个参数,所以要用CHR(34)给路径强行加上双引号;
'因为参数也可能是包含路径的文件名,所以也要做相同处理;
'程序与参数间要用SPACE(1)来加空格,直接在路径中加空格是行不通的,注册表里解释时会出错
MsgBOX "已经OK!"

Else

WScript.echo "用户取消设置!"

END IF
WScript.Quit  '' Terminate script.