|
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 ---------------------------------------- |
|
|
