vbs操作offfice文档

Rem 打开一个word文档 'Sub OpenWordFile(filespec) 'Dim ObjWD,ObjDOC 'Set ObjWD=CreateObject("Word.application") 'Set ObjDOC=ObjWD.Documents.Open(filespec) 'ObjWD.Visible=True 'End Sub Rem 打开一个excek文档 'Sub OpenE xcelFile(filespec) 'Dim ObjWD,ObjDOC 'Set ObjWD=CreateObject("Excel.application") 'Set ObjDOC=ObjWD.Workbooks.Open(filespec) 'ObjWD.Visible=True 'End Sub Rem 打开一个ppt文档 'Sub OpenPptFile(filespec) 'Dim ObjWD,ObjDOC 'Set ObjWD=CreateObject("PowerPoint.Application") 'Set ObjDOC=ObjWD.Presentations.Open(filespec) 'ObjWD.Visible=True 'End Sub Rem -------------------------------------------------------------------------------- Rem 判断输入(filespec)的路径是否存在，如存在IsExitAFile为true，否则为false Function IsExitAFile(filespec) Dim fso Set fso=CreateObject("Scripting.FileSystemObject")
If fso.fileExists(filespec) Then
IsExitAFile=True
Else IsExitAFile=False
End If End Function Rem -------------------------------------------------------------------------- Rem 如果输入(filespec)的路径不存在，则在此路径下新建一个文档 Sub CreateAFile(filespec) Dim fso Set fso=CreateObject("Scripting.FileSystemObject") fso.CreateTextFile(filespec) End Sub Rem -------------------------------------------------------------------------- Rem 判断文件类型 SUb DecideFileType(filespec) Dim ObjWD,ObjDOC Rem 截取路径中文件扩展名 Set WshShell = WScript.CreateObject("WScript.Shell") DFileType=Mid(filespec,InStrRev(filespec,".")) If DFileType=".docx" Then Set ObjWD=CreateObject("Word.application") Set ObjDOC=ObjWD.Documents.Open(filespec) ObjWD.Visible=True Set ObjDOC=ObjWD.ActiveDocument '等待1000秒 WScript.Sleep 10000 ObjWD.CommandBars("Standard").Visible=True ObjWD.CommandBars("Formatting").Visible=True ObjWD.CommandBars("文件").Controls("打印(&P)...").Visible=False '新建一个word文档 'Set ObjDOC=ObjWD.Documents.Add() '将WORD窗口最大化 'ObjWD.WindowState=1 'Call EndProcess(Process) 'ObjDOC.SaveAs2("C:\Users\jin\Desktop\test1\word3.docx") ElseIf DFileType=".xlsx" Then Set ObjWD=CreateObject("Excel.application") Set ObjDOC=ObjWD.Workbooks.Open(filespec) ObjWD.Visible=True Call EndProcess(Process) ElseIf DFileType=".pptx" Then Set ObjWD=CreateObject("PowerPoint.Application") Set ObjDOC=ObjWD.Presentations.Open(filespec) ObjWD.Visible=True Call EndProcess(Process) Else MsgBox("没有关联的应用程序") End IF End Sub Rem -------------------------------------------------------------------------------------- Rem 检测到进程存在则杀进程，此处进程名必须与任务管理器里的一样(区分大小写) Sub EndProcess(Process) Dim MyProcessName Dim GetCurrentWindowsLoginName,MySysLoginName Set FullWMIProcess=GetObject("winmgmts:\.\root\cimv2").ExecQuery("Select * From Win32_Process") For Each FullSysProcess in FullWMIProcess MyProcessName=FullSysProcess.Name MyProcessPropterties=FullSysProcess.GetOwner(strNameOfUser,strUserDomain) 'WScript.Echo Mid(MyProcessName,1,20) &vbTab& strNameOfUser &vbTab& FullSysProcess.ProcessID '获取当前Windows登录用户的登录名(计算机没有加入AD域) Set GetCurrentWindowsLoginName=WScript.CreateObject("Wscript.Network") MySysLoginName=GetCurrentWindowsLoginName.UserName If MyProcessName=Process And strNameOfUser=MySysLoginName Then '调试时在控制台输出进程名，用户，进程ID 'WScript.Echo Mid(MyProcessName,1,20) &vbTab& strNameOfUser &vbTab& FullSysProcess.ProcessID Dim WshShell Set WshShell=WScript.CreateObject("wscript.shell") '强杀drmlayerUser进程 'WshShell.Run "taskkill /im drmLayerUser.exe /f",0,True '获取用户空间drmlayerUser进程的PID，然后杀指定PID的进程 WshShell.Run "taskkill /PID "&FullSysProcess.ProcessID&" /f",0,True MsgBox "drmLayerUser进程已结束","提示" End If Next End Sub Rem ---------------------------------------------------------------------------------------------------------------- Rem 定义filespec，并输入filespec的值(路文档路径) Dim filespec Dim Process Process="layeruser.exe" filespec=InputBox("输入文档路径,路径不能为空","提示") If filespec=vbEmpty Then 'msgbox消息框点取消按钮 Buffer=MsgBox("确定关闭文档路径输入框", vbOKOnly,"提示") Else 'msgbox消息框点确定按钮 If Len(filespec)=0 Then '文本框内容长度为零，则关闭消息提示框 Buffer=MsgBox("输入的路径为空，请重新运行程序", VbOKOnly) Else '文本框内容长度不零 'Buffer=MsgBox(filespec, vbOKOnly, "文档路径") '文本框内容长度不为零，则判断目录是否存在 aDirectoriesType=Len(filespec) bDirectoriesType=left(filespec,InStrRev(filespec,"")) Dim fso Set fso=CreateObject("Scripting.FileSystemObject") If fso.folderExists(bDirectoriesType) Then '目录存在 If IsExitAFile(filespec) Then '判断文件类型 Call DecideFileType(filespec) Else '文件不存在 CreateAFile(filespec) DecideFileType(filespec) End If Else '目录不存在 MsgBox "输入的路径不存在，请重新运行程序","提示" End If End If End If