VBS批量打印word和EXCEL

以下是批量打印文件夹下的所有的WORD文件 ,谁能帮我修改为批量打印文件夹下的所有EXCEL文件 非常感谢!filterstr=inputbox("请输入不要打印的文件,用逗号分隔。如2,1表示文件名包含2或者1的不打印,输入*表示打印所有:")filtered=falseprintme=trueif filterstr<>"*" and filterstr<>"" then filtered=true filterlist=split(filterstr,",")end ifif filterstr<>"" then Set WshShell = WScript.CreateObject("WScript.Shell") printsub(WshShell.CurrentDirectory) msgbox "完工啦!"end ifSub printsub(byval curdc) Set FSO =CreateObject("Scripting.FileSystemObject") Set WD = CreateObject("Word.Application") wd.visible=false Set FD = FSO.GetFolder(curdc) Set FN = FD.Files For Each F1 In FN if filtered then printme=true for each fl in filterlist if Instr(LCase(Left(F1.Name,len(F1.Name)-3)),fl)<>0 then printme=false end if next end if If UCase(Right(F1.Name, 3)) = "DOC" and printme Then set doc=WD.Documents.Open(FD.Path & "尀" & F1.Name) doc.PrintOut doc.close ✀WD.Documents.Close set doc=nothing End If Next wd.visible=true WD.Quit Set SubFD=FD.SubFolders For Each folder in SubFD printsub(folder.Path) Next Set SubFD=nothing set fn=nothing set fd=nothing Set WD = Nothing Set FSO = NothingEnd Sub
2026年09月24日 23:54
有1个网友回答
网友(1):

filterstr=inputbox("请输入不要打印的文件,用逗号分隔。如2,1表示文件名包含2或者1的不打印,输入*表示打印所有:")
filtered=false
printme=true
if filterstr<>"*" and filterstr<>"" then
filtered=true
filterlist=split(filterstr,",")
end if
if filterstr<>"" then
Set WshShell = WScript.CreateObject("WScript.Shell")
printsub(WshShell.CurrentDirectory)
msgbox "完工啦!"
end if
Sub printsub(byval curdc)
Set FSO =CreateObject("Scripting.FileSystemObject")
Set WD = CreateObject("Excel.Application")
wd.visible=false
Set FD = FSO.GetFolder(curdc)
Set FN = FD.Files
For Each F1 In FN
if filtered then
printme=true
for each fl in filterlist
if Instr(LCase(Left(F1.Name,len(F1.Name)-3)),fl)<>0 then
printme=false
end if
next
end if
If UCase(Right(F1.Name, 3)) = "XLS" and printme Then
Set myWork = GetObject(FD.Path & "\" & F1.Name)
Set mySheet = GetObject(FD.Path & "\" & F1.Name).Worksheets(1)
mySheet.PrintOut
myWork.Close saveChanges=False
End If
Next
wd.visible=true
WD.Quit
Set SubFD=FD.SubFolders
For Each folder in SubFD
printsub(folder.Path)
Next
Set SubFD=nothing
set fn=nothing
set fd=nothing
Set WD = Nothing
Set FSO = Nothing
End Sub
如果你是excel2007以上的,请把代码中的“XLS”改成“LSX”即可。