Creating macro converting docx files into pdf

Question

Hello,
I'm trying to create a macro that automatically find all .docx and .xlsx files into selected folder and convert them into PDFs files. I already make something but it converts too much (for example gifs files). Can you help me in that?
Thanks in advance for your help.
Robert

Answer 1

Run this macro from Word:
Sub ConvertWord2PDF()
Dim strFolder As String
Dim strFile As String
Dim doc As Document
Dim lngPos As Long
Dim strPDFName As String
With Application.FileDialog(4)
If .Show Then
strFolder = .SelectedItems(1)
Else
MsgBox "You didn't specify a folder!", vbExclamation
Exit Sub
End If
End With
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strFolder & "*.doc*")
Do While strFile <> ""
Set doc = Documents.Open(FileName:=strFolder & strFile, _
AddToRecentFiles:=False)
lngPos = InStrRev(strFile, ".")
strPDFName = Left(strFile, lngPos) & "pdf"
doc.ExportAsFixedFormat OutputFileName:=strFolder & strPDFName, _
ExportFormat:=wdExportFormatPDF
doc.Close SaveChanges:=True
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
and this one from Excel:
Sub ConvertExcel2PDF()
Dim strFolder As String
Dim strFile As String
Dim wbk As Workbook
Dim lngPos As Long
Dim strPDFName As String
With Application.FileDialog(4)
If .Show Then
strFolder = .SelectedItems(1)
Else
MsgBox "You didn't specify a folder!", vbExclamation
Exit Sub
End If
End With
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strFolder & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(Filename:=strFolder & strFile)
lngPos = InStrRev(strFile, ".")
strPDFName = Left(strFile, lngPos) & "pdf"
wbk.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFolder & strPDFName
wbk.Close SaveChanges:=True
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Regards, Hans Vogelaar (http://www.eileenslounge.com)