Consulting

Results 1 to 3 of 3

Thread: Error while exporting to pdf

  1. #1
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location

    Error while exporting to pdf

    Dear Team,


    I wrote code for sending mail with pdf attachment. When i am running my code i am getting following error message



    But some of the condition this error message is not displaying.

    Mu code is here
    Sub Remindermail()
    Dim lRow As Integer
    Dim i As Integer
    Dim toDate As Date
    Dim toList, CCList As String
    Dim eSubject As String
    Dim eBody As String
    Dim OutApp As Object, _
    OutMail As Object
    Dim Signature As String
    Dim sPath As String
    Dim S As String
    Dim sht As Worksheet
    Dim rng As Range
    Dim sh As Worksheet
    
    
    
    
    With Application
    
    
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    
    
    Set sht = Sheets("Master data")
    Set sh = Sheets("Data")
    
    
    Set rng = Nothing
    ' Only send the visible cells in the selection.
    Set rng = sh.Range("C2:D3").SpecialCells(xlCellTypeVisible)
    If rng Is Nothing Then
        MsgBox "An unknown error has occurred. "
        Exit Sub
    End If
    
    
    'On Error GoTo err_exit
    With sht
    lRow = .Cells(.Rows.Count, 4).End(xlUp).Row
    
    
    Set OutApp = CreateObject("Outlook.Application")
    
    
    'S = Environ("appdata") & "\Microsoft\Signatures\"
    'If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
    'S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).ReadAll
    
    
    For i = 4 To lRow
    If Cells(i, 5).Value <= 100 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
    .Cells(i, 6).Value <= 100 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
    .Cells(i, 7).Value <= 250 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
    .Cells(i, 24).Value <= 50 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
    .Cells(i, 10).Value <= 250 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
    .Cells(i, 20).Value <= 50 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
    .Cells(i, 20).Value >= 50 And .Cells(i, 20).Value <= 100 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Or _
    .Cells(i, 20).Value >= 200 And .Cells(i, 20).Value <= 250 And Cells(i, 23).Value = "" And Cells(i, 23).Value < 30 Then
    Set OutMail = OutApp.CreateItem(0)
    
    
    If Cells(i, 21).Value = "" Then
    Range("U" & i).Value = "Mail Sent on"
    Range("V" & i).Value = Format(Now, "YYYY-MM-DD")
    End If
    
    
    toList = .Cells(i, 26)
    
    
    'CCList = Worksheets("Data").Cells(7, 3) & "; " & Worksheets("Data").Cells(8, 3) _
    & "; " & Worksheets("Data").Cells(9, 3) & "; " & Worksheets("Data").Cells(10, 3) _
    & "; " & Worksheets("Data").Cells(11, 3)
    
    
    
    
    If .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine / Transmission / Axle & Hydraulic] Service"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine / Transmission & Axle] Service"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine / Transmission & Hydraulic] Service"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine & Axle] Service"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine & Transmission] Service"
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission / Axle & Hydraulic] Service"
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission & Axle] Service"
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission & Hydraulic] Service"
    ElseIf .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Axle & Hydraulic] Service"
    ElseIf .Cells(i, 5).Value <= 100 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Engine] Service"
    ElseIf .Cells(i, 6).Value <= 100 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Transmission] Service"
    ElseIf .Cells(i, 7).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Axle] Service"
    ElseIf .Cells(i, 10).Value <= 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine [Hydraulic] Service"
    ElseIf .Cells(i, 20).Value >= 0 And .Cells(i, 20).Value < 50 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine Engine First Oil Service"
    ElseIf .Cells(i, 20).Value > 50 And .Cells(i, 20).Value < 100 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine Transmission First Oil Service"
    ElseIf .Cells(i, 20).Value > 100 And .Cells(i, 20).Value < 250 Then
    eSubject = "Reminder for your " & .Cells(i, 3) & " Machine Axle First Oil Service"
    End If
    
    
    
    
    eBody = "<p style='font-family:Cambria;font-size: 12pt'>" & "Dear Sir, <br><br>" _
    & "Greetings from " & "<b> SCHWING STETTER! </b><br><br>" _
    & " We hope you're doing well.<br><br>" _
    & " We wanted to inform you that your " & "<b>" & Cells(i, "C").Value & "</b>" _
    & " Machine (Sr.No: " & "<b>" & Cells(i, "D") & "</b>" _
    & ") reached " & "<b>" & .Cells(i, "T").Value & "</b>" & "hrs and due for next oil service.<br><br>" _
    & " So kindly arrange the consumables as per the attachment.<br><br>" _
    & " We truly care about your well-being, so if you have any questions or needs in advance of your appointment, you are welcome to call us anytime," & RangetoHTML(rng) & "<br><br>" & "</p>"
    
    
    'Print '************************************************* ********
     'Turns off screen updating
     Application.ScreenUpdating = False
     'Makes a copy of the active sheet and save it to a temporary file
     Dim wks As Worksheet
     mySheet = Worksheets("Master data").Cells(i, "C").Value
     TempFilePath = Environ$("temp") & "\"
     'TempFileName = mySheet & "Service details.pdf"
    If .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Engine / Transmission / Axle & Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
    TempFileName = mySheet & " Machine Engine / Transmission & Axle Service Spares.pdf"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Engine / Transmission & Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Engine / Axle & Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Transmission / Axle & Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 Then
    TempFileName = mySheet & " Machine Engine & Axle Service Spares.pdf"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 Then
    TempFileName = mySheet & " Machine Engine & Transmission Service Spares.pdf"
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Engine & Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
    TempFileName = mySheet & " Machine Transmission & Axle Service Spares.pdf"
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Transmission & Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Axle & Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 5).Value <= 100 Then
    TempFileName = mySheet & " Machine Engine Service Spares.pdf"
    ElseIf .Cells(i, 6).Value <= 100 Then
    TempFileName = mySheet & " Machine Transmission Service Spares.pdf"
    ElseIf .Cells(i, 7).Value <= 250 Then
    TempFileName = mySheet & " Machine Axle Service Spares.pdf"
    ElseIf .Cells(i, 10).Value <= 250 Then
    TempFileName = mySheet & " Machine Hydraulic Service Spares.pdf"
    ElseIf .Cells(i, 20).Value > 0 And .Cells(i, 20).Value < 50 Then
    TempFileName = mySheet & " Machine First Engine Oil Service Spares.pdf"
    ElseIf .Cells(i, 20).Value > 50 And .Cells(i, 20).Value < 100 Then
    TempFileName = mySheet & " Machine First Transmission Oil Service Spares.pdf"
    ElseIf .Cells(i, 20).Value > 200 And .Cells(i, 20).Value < 250 Then
    TempFileName = mySheet & " Machine First Axle Oil Service Spares.pdf"
    End If
    
    
    'FileFullPath = TempFilePath & TempFileName
    FileFullPath = TempFileName
     Set MR = Cells(i, "C")
     If .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B879:F934").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
     Worksheets(mySheet).Range("B649:F699").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B705:F758").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B763:F815").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B820:F870").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 7).Value <= 250 Then
     Worksheets(mySheet).Range("B389:F436").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 6).Value <= 100 Then
     Worksheets(mySheet).Range("B336:F385").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 5).Value <= 100 And .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B443:F493").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 7).Value <= 250 Then
     Worksheets(mySheet).Range("B495:F540").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 6).Value <= 100 And .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B542:F592").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 7).Value <= 250 And .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B598:F645").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 5).Value <= 100 Then
     Worksheets(mySheet).Range("B145:F191").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 6).Value <= 100 Then
     Worksheets(mySheet).Range("B193:F236").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 7).Value <= 250 Then
     Worksheets(mySheet).Range("B240:F283").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 10).Value <= 250 Then
     Worksheets(mySheet).Range("B287:F333").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 20).Value > 0 And .Cells(i, 20).Value < 50 Then
     Worksheets(mySheet).Range("B2:F46").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 20).Value > 50 And .Cells(i, 20).Value < 100 Then
     Worksheets(mySheet).Range("B49:F93").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ElseIf .Cells(i, 20).Value > 200 And .Cells(i, 20).Value < 250 Then
     Worksheets(mySheet).Range("B97:F140").ExportAsFixedFormat _
     Type:=xlTypePDF, FileName:=FileFullPath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
    
    
    
    
    
    
    
    
    On Error Resume Next
    
    
    With OutMail
    .To = toList
    .CC = CCList
    .BCC = ""
    .Subject = eSubject
    .HTMLBody = eBody
    .display
    .Attachments.Add FileFullPath
    '.Send
    
    
    End With
    
    
    On Error GoTo 0
    End If
    Next i
    End With
    
    
    Set OutApp = Nothing
    
    
    
    
    ActiveWorkbook.Save
    
    
    err_exit:
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    End With
    'Sheets("Master data").Range("A1").Select
    
    
    End Sub
    
    
    
    
    Function RangetoHTML(rng As Range)
        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Workbook
        TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
        'Copy the range and create a new workbook to past the data in
        rng.Copy
        Set TempWB = Workbooks.Add(1)
        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial xlPasteValues, , False, False
            .Cells(1).PasteSpecial xlPasteFormats, , False, False
            .Cells(1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            On Error GoTo 0
        End With
        'Publish the sheet to a htm file
        With TempWB.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             FileName:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
        End With
        'Read all data from the htm file into RangetoHTML
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.ReadAll
        ts.Close
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
        'Close TempWB
        TempWB.Close savechanges:=False
        'Delete the htm file we used in this function
        Kill TempFile
        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
    End Function
    Can any one help me why i am getting this error message.

  2. #2
    You didn't post the error message, but there is plenty to go at. Start by adding Option Explicit to the top of the module. Then you will see that you have undeclared and wrongly declared variables the most obvious of which is that you have declared wks as the worksheet then used mySheet in your code? You also have several paths defined that are clearly invalid e.g.
    TempFileName = mySheet & " Machine Engine / Transmission / Axle & Hydraulic Service Spares.pdf"
    which has spaces either side of the folder separators. That should keep you amused for a while.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Contributor
    Joined
    Jun 2019
    Posts
    155
    Location
    Dear Graham Mayor,

    Thanks for your reply.

    I had removed the spaces. Now it is working great.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •