vbs操作offfice文檔

Rem 打開(kāi)一個(gè)word文檔
'Sub OpenWordFile(filespec)
'Dim ObjWD,ObjDOC
'Set ObjWD=CreateObject("Word.application")
'Set ObjDOC=ObjWD.Documents.Open(filespec)
'ObjWD.Visible=True
'End Sub
Rem 打開(kāi)一個(gè)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 打開(kāi)一個(gè)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)的路徑不存在，則在此路徑下新建一個(gè)文檔
Sub CreateAFile(filespec)
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile(filespec)
End Sub
Rem --------------------------------------------------------------------------
Rem 判斷文件類(lèi)型
SUb DecideFileType(filespec)
Dim ObjWD,ObjDOC
Rem 截取路徑中文件擴(kuò)展名
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
'新建一個(gè)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("沒(méi)有關(guān)聯(lián)的應(yīng)用程序")
End IF
End Sub
Rem --------------------------------------------------------------------------------------
Rem 檢測(cè)到進(jìn)程存在則殺進(jìn)程，此處進(jìn)程名必須與任務(wù)管理器里的一樣(區(qū)分大小寫(xiě))
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
'獲取當(dāng)前Windows登錄用戶的登錄名(計(jì)算機(jī)沒(méi)有加入AD域)
Set GetCurrentWindowsLoginName=WScript.CreateObject("Wscript.Network")
MySysLoginName=GetCurrentWindowsLoginName.UserName
If MyProcessName=Process And strNameOfUser=MySysLoginName Then
'調(diào)試時(shí)在控制臺(tái)輸出進(jìn)程名，用戶，進(jìn)程ID
'WScript.Echo Mid(MyProcessName,1,20) &vbTab& strNameOfUser &vbTab& FullSysProcess.ProcessID
Dim WshShell
Set WshShell=WScript.CreateObject("wscript.shell")
'強(qiáng)殺drmlayerUser進(jìn)程
'WshShell.Run "taskkill /im drmLayerUser.exe /f",0,True
'獲取用戶空間drmlayerUser進(jìn)程的PID，然后殺指定PID的進(jìn)程
WshShell.Run "taskkill /PID "&FullSysProcess.ProcessID&" /f",0,True
MsgBox "drmLayerUser進(jìn)程已結(jié)束","提示"
End If
Next
End Sub
Rem ----------------------------------------------------------------------------------------------------------------
Rem 定義filespec，并輸入filespec的值(路文檔路徑)
Dim filespec
Dim Process
Process="layeruser.exe"
filespec=InputBox("輸入文檔路徑,路徑不能為空","提示")
If filespec=vbEmpty Then
'msgbox消息框點(diǎn)取消按鈕
Buffer=MsgBox("確定關(guān)閉文檔路徑輸入框", vbOKOnly,"提示")
Else
'msgbox消息框點(diǎn)確定按鈕
If Len(filespec)=0 Then
'文本框內(nèi)容長(zhǎng)度為零，則關(guān)閉消息提示框
Buffer=MsgBox("輸入的路徑為空，請(qǐng)重新運(yùn)行程序", VbOKOnly)
Else
'文本框內(nèi)容長(zhǎng)度不零
'Buffer=MsgBox(filespec, vbOKOnly, "文檔路徑")
'文本框內(nèi)容長(zhǎng)度不為零，則判斷目錄是否存在
aDirectoriesType=Len(filespec)
bDirectoriesType=left(filespec,InStrRev(filespec,"\"))
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
If fso.folderExists(bDirectoriesType) Then
'目錄存在
If IsExitAFile(filespec) Then
'判斷文件類(lèi)型
Call DecideFileType(filespec)
Else
'文件不存在
CreateAFile(filespec)
DecideFileType(filespec)
End If
Else
'目錄不存在
MsgBox "輸入的路徑不存在，請(qǐng)重新運(yùn)行程序","提示"
End If
End If
End If