Sub ToPdf2()
Application.ScreenUpdating= False
'关闭屏幕更新
'遍历指定文件夹下的所有工作薄--Dir()函数
'Dir[(pathname[,attributes])]
'两个参数都是可选的,attributes表示文件属性。
'返回一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配
'在第一次调用 Dir 函数时,必须指定 pathname,否则会产生错误。
'dir会返回匹配pathname的第一个文件名,若想得到其他匹配pathname的文件名,再一次调用dir,且不要使用参数。如果已没有合乎条件的文件,则dir会返回一个零长度字符串("").
'一旦返回零长度字符串,并要再次调用dir时,就必须指定pathname,就会产生错误。不必访问到所有匹配当前pathname的文件名,就可以改变到一个新的pathname上,但是,不能以 _
递归方式来调用Dir函数。以VBDirectory属性来调用Dir不能连续的返回子目录
Dim fname As String
Dim mypath As String
mypath= ThisWorkbook.Path
fname= Dir(mypath & "\目标文件夹\*.xlsx")
Do While Len(fname) <> 0
Workbooks.Open mypath & "\目标文件夹\"& fname
ChDrive "e:\"
'设置当前驱动器为E盘即目标文件夹所在的盘符
ChDir mypath & "\目标文件夹\pdf\"
'设置PDF文件存储位置,本示例存储在原EXCEL所在文件夹的PDF文件夹中,如无此语句,默认存储在宏工作簿所在路径
'文件另存为PDF,与上例一样
Workbooks(fname).ExportAsFixedFormatType:=xlTypePDF, Filename:= _
Left(fname, InStrRev(fname, ".") -1) & ".pdf", Quality:= _
xlQualityStandard,IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Workbooks(fname).Close savechanges:=False
fname = Dir()
'第二次调用dir函数,不带任何参数,则函数返回同一目录下的下一个.xlsx文件
Loop
Application.ScreenUpdating= True
'打开屏幕更新
End Sub