Option Explicit
Dim FileAddress As String
Dim TargetAddress As String
Sub Main()
Application.ScreenUpdating = False
Dim tempStr
FileAddress = 'C:\Userfile '
TargetAddress = 'C:\Userfile \PDF\'
tempStr = Dir(FileAddress & '\*.docx')
While tempStr <> ''
Documents.Open FileAddress & '\' & tempStr
SaveAsPdfFile
Documents(tempStr).Close False
tempStr = Dir
Wend
Application.ScreenUpdating = True
End Sub
Sub SaveAsPdfFile()
Dim strDocName, strPdfName As String
Dim intPos As Integer
' Find position of extension in file name
strDocName = ActiveDocument.Name
intPos = InStrRev(strDocName, '.')
If intPos = 0 Then
' If the document has not yet been saved
' Ask the user to provide a file name
strDocName = InputBox('Please enter the name ' & _
'of your document.')
Else
' Strip off extension and add '.txt' extension
strDocName = Left(strDocName, intPos - 1)
strPdfName = strDocName & '.pdf'
End If
' Save file with new extension
ActiveDocument.SaveAs2 FileName:=TargetAddress & strPdfName, _
FileFormat:=wdFormatPDF
End Sub
联系客服