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

转载于:https://blog.51cto.com/2487980/2337312