Error when looping to create PDFs - Excel VBA

[CancelThisAccount2]

Help?


Private Sub MakeMeaPDF(ws As Worksheet)

Dim PSFileName As String, SavePath As String, PDFFileName As String, FileName As String
Dim MySheet As Worksheet
Dim myPDF As PdfDistiller

If Sheet1.Range("A1") = False Or Sheet1.Range("A1") = "" Then myBrowse

If Sheet1.Range("A1") = False Or Sheet1.Range("A1") = "" Then
MsgBox "You must have a Save Location to continue." & Chr(10) & "Exiting Program", , "Save Location Error!"
Exit Sub
End If

FileName = ws.Range("H8").Value
SavePath = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value

PSFileName = SavePath & "\" & FileName & ".ps"
PDFFileName = SavePath & "\" & FileName & ".pdf"
Set myPDF = New PdfDistiller

ws.Activate

'Adobe PDF is used by 7.0
'Acrobat Distiller is the earlier version
'ActiveWorkbook.PrintOut ActivePrinter:="Adobe PDF", printtofile:=True, prtofilename:=PSFileName
ws.PrintOut ActivePrinter:="Acrobat Distiller", printtofile:=True, prtofilename:=PSFileName

On Error Resume Next
Kill PDFFileName
On Error GoTo 0

'On Error GoTo PDFSettings
'Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 15)
'On Error Resume Next
myPDF.FileToPDF PSFileName, PDFFileName, ""
On Error GoTo 0

Kill PSFileName

Set myPDF = Nothing
Exit Sub

PDFSettings:
MsgBox ("There was a problem creating the PDF. Please verify your Printer properties" & Chr(10) & _
"Before you run this program, you need to open the Adobe Pdf printer properties, Printing preferences, Adobe PDF settings and" & _
"uncheck: Do not send fonts to distiller")
Kill PSFileName
Exit Sub

End Sub

Sub PDFWorkbook()
Dim ws As Worksheet

With ActiveWorkbook
For Each ws In .Worksheets
MakeMeaPDF ws
Next ws
End With

Set ws = Nothing
End Sub

 

[CancelThisAccount2]

Nevermind - figured it out. Put a Wait before the set mypdfApplication.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)

seems to give it more time on the second run....

oh well it works.