Sub ToPdf2()

Application.ScreenUpdating= False

'關(guān)閉屏幕更新

'遍歷指定文件夾下的所有工作薄--Dir()函數(shù)

'Dir[(pathname[,attributes])]

'兩個(gè)參數(shù)都是可選的，attributes表示文件屬性。

'返回一個(gè)文件名、目錄名或文件夾名稱，它必須與指定的模式或文件屬性、或磁盤卷標(biāo)相匹配

'在第一次調(diào)用 Dir 函數(shù)時(shí)，必須指定 pathname，否則會產(chǎn)生錯(cuò)誤。

'dir會返回匹配pathname的第一個(gè)文件名，若想得到其他匹配pathname的文件名，再一次調(diào)用dir，且不要使用參數(shù)。如果已沒有合乎條件的文件，則dir會返回一個(gè)零長度字符串（''）.

'一旦返回零長度字符串，并要再次調(diào)用dir時(shí)，就必須指定pathname,就會產(chǎn)生錯(cuò)誤。不必訪問到所有匹配當(dāng)前pathname的文件名，就可以改變到一個(gè)新的pathname上，但是，不能以 _

 遞歸方式來調(diào)用Dir函數(shù)。以VBDirectory屬性來調(diào)用Dir不能連續(xù)的返回子目錄

Dim fname As String

Dim mypath As String

mypath= ThisWorkbook.Path

fname= Dir(mypath & '\目標(biāo)文件夾\*.xlsx')

Do While Len(fname) <> 0

    Workbooks.Open mypath & '\目標(biāo)文件夾\'& fname

     ChDrive 'e:\'      

'設(shè)置當(dāng)前驅(qū)動器為E盤即目標(biāo)文件夾所在的盤符

     ChDir mypath & '\目標(biāo)文件夾\pdf\' 

'設(shè)置PDF文件存儲位置,本示例存儲在原EXCEL所在文件夾的PDF文件夾中，如無此語句，默認(rèn)存儲在宏工作簿所在路徑

'文件另存為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() 

'第二次調(diào)用dir函數(shù)，不帶任何參數(shù)，則函數(shù)返回同一目錄下的下一個(gè).xlsx文件

Loop

Application.ScreenUpdating= True

'打開屏幕更新

End Sub

----------------------------------------