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