1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to save e-mail as PDF with excel VBA

Discussion in 'VBA Macros' started by ThrottleWorks, Jan 16, 2019.

  1. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,

    I need to export e-mail as PDF and save.
    User has shared Outlook.

    In one of the shared account he will have one particular folder.
    This folder might have n number of e-mails, let us say 500.
    From this 500, I need to export each e-mail as PDF and save.

    One more condition is, if the subject line of e-mails is same.
    I need to export latest e-mail for that subject line and save.

    Is it possible. Can anyone please help me with this.
    If you can help me with PDF part then also I will be very thankful.
  2. Deepak

    Deepak Excel Ninja

    Messages:
    2,881
  3. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi @Deepak sir, how are you !

    Thanks a lot for the help. Am checking this and will revert with details.
    Good night. :)
  4. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi @Deepak sir.
    I am getting error at below line.
    Could you please help if you get time.

    Set MyOlNamespace = Application.GetNamespace("MAPI")

    Object does not support this property method.
    I have clicked on all the required references.
  5. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
  6. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,

    The code at below mentioned link works perfectly with plain text e-mail.

    https://www.msoutlook.info/question/saving-emails-as-pdf-files

    However, for e-mail containing screenshot, pictures and tables.
    Entire content is not exported to PDF.

    Pictures or screenshots are cropped from right side.
    However other than pictures, entire text is exported with original format.

    Can anyone please help me in this.
  7. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,

    Can anyone help me in this please.
  8. Kenneth Hobson

    Kenneth Hobson Active Member

    Messages:
    245
    If you want the body, then the WordEditor method might suffice. If you want the header to, converting those to msg and then pdf might be best. There are several msg to pdf converters out there.

    Your code need then is to simply create the needed msg files. I would put them in a conversion folder. Then manually, run the conversion utility. I guess that might be cheaper than Acrobat. If you had Acrobat, it could likely all be done by code.
    ThrottleWorks likes this.
  9. Deepak

    Deepak Excel Ninja

    Messages:
    2,881
    Didn't encounter such issue...

    Will you pls share a sample email, This might be issue of mht encoding..

    (If privately then inbox : imdkbj at outlook dot com)
    ThrottleWorks likes this.
  10. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,

    I am getting below mentioned error while running this code.
    Can anyone please help me in this.

    Run time error 462
    The remote server machine does not exist or is unavailable

    Bug is appearing at below line.
    “wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName”

    This line is in the second procedure of the attached code.
    Procedure name is “Sub PDF_Working”.

    Export_To_PDF is the main procedure.

    This procedure calls PDF_Working and Sort_Conversation_ID.

    We can skip Sort_Conversation_ID procedure.

    In Export_To_PDF, procedure, user selects any Outlook folder.
    Macro tries to export all the e-mails from this picked folder.
    This procedure process each mail via loop.
    For Each Item In olFolder.Items
    For each e-mail main procedure call ‘PDF_Working’.
    Converting and saving e-mail to PDF is done in this procedure.

    Macro runs good for first instance of the loop.
    Bug appears from the second instance. Not able to understand why this is happening.

    Code (vb):

    Option Explicit
    Public MacroBook As Workbook
    Public MacroSht As Worksheet
    Public MapSht As Worksheet
    Public Item As Object
    Public olFolder As outlook.MAPIFolder

    Sub Export_To_PDF()
        Application.ScreenUpdating = False
        Application.StatusBar = "Macro in progress, please wait!"

    Set MacroBook = ThisWorkbook
        Set MacroSht = MacroBook.Worksheets("MainPage")
        Set MapSht = MacroBook.Worksheets("Mapping")

    Dim objNS As outlook.Namespace
        Dim oMail As outlook.MailItem
        Dim TempLr As Long

    Set objNS = GetNamespace("MAPI")
        Set olFolder = objNS.PickFolder
        Set oMail = Item

    For Each Item In olFolder.Items
            If TypeOf Item Is outlook.MailItem Then
                Application.StatusBar = Item.Subject & " " & Item.ReceivedTime
                Call PDF_Working
                TempLr = MapSht.Cells(MapSht.Rows.Count, 3).End(xlUp).Row + 1
                MapSht.Cells(TempLr, 3).FormulaR1C1 = "=ROW(R[-1]C[-2])" 'C Sr
               MapSht.Cells(TempLr, 4) = Item.Subject 'D Email Subject
               MapSht.Cells(TempLr, 5) = Item.ConversationID 'E Conversation ID
               MapSht.Cells(TempLr, 6) = Item.ConversationTopic 'F Conversation Topic
               MapSht.Cells(TempLr, 7) = Item.ReceivedTime 'G Received Time
               MapSht.Cells(TempLr, 8) = Item.To 'H To
               MapSht.Cells(TempLr, 9) = Item.Sender 'I From
               MapSht.Cells(TempLr, 10) = Now 'J Run time
           End If
        Next
        Call Sort_Conversation_ID
        MacroBook.Activate
        Application.ScreenUpdating = True
        Application.StatusBar = False
        MsgBox "Done !"
    End Sub


    Sub PDF_Working()
        Dim MySelectedItem As MailItem
        Dim FSO As Object
        Dim TmpFileName As String
        Dim StrName As String
        Dim wrdApp As Object
        Dim wrdDoc As Object
        Dim My_MHT_File As String
        Dim msgFileName As String
        Dim oRegEx As Object
        Dim strCurrentFile As String
        Dim Response As String
        Dim bStarted As Boolean
        Dim intPos As Long
        Dim fdfs As FileDialogFilters
        Dim dlgSaveAs As FileDialog
        Dim i As Long
        Dim fdf As FileDialogFilter
        Dim WshShell As Object
        Dim SpecialPath As String
        Dim MyOlNamespace As Namespace

        Set MyOlNamespace = outlook.Application.GetNamespace("MAPI") 'Mapi
       Set MySelectedItem = Item
        Set FSO = CreateObject("Scripting.FileSystemObject")

        TmpFileName = FSO.GetSpecialFolder(2)
        StrName = "email_temp.mht"

        On Error Resume Next
            Kill TmpFileName
        On Error GoTo 0

        Set MyOlNamespace = outlook.Application.GetNamespace("MAPI")
        Set MySelectedItem = Item
        Set FSO = CreateObject("Scripting.FileSystemObject")

        TmpFileName = FSO.GetSpecialFolder(2)
        StrName = "email_temp.mht"
        TmpFileName = TmpFileName & "\" & StrName
        MySelectedItem.SaveAs TmpFileName, 10

        On Error Resume Next
        Set wrdApp = GetObject(, "Word.Application")
        If Err Then
        Set wrdApp = CreateObject("Word.Application")
        bStarted = True
        End If
        On Error GoTo 0

        Set wrdDoc = wrdApp.Documents.Open(Filename:=TmpFileName, Visible:=False, Format:=7)
        Set dlgSaveAs = wrdApp.FileDialog(msoFileDialogSaveAs)
        Set fdfs = dlgSaveAs.Filters

        i = 0

        For Each fdf In fdfs
        i = i + 1
        If InStr(1, fdf.Extensions, "pdf", vbTextCompare) > 0 Then
        Exit For
        End If
        Next fdf

        dlgSaveAs.FilterIndex = i

        Set WshShell = CreateObject("WScript.Shell")

        SpecialPath = WshShell.SpecialFolders(16)
        msgFileName = MySelectedItem.Subject

        Set oRegEx = CreateObject("vbscript.regexp")

        oRegEx.Global = True
        oRegEx.Pattern = "[\/:*?""<>|]"

        msgFileName = Trim(oRegEx.Replace(msgFileName, ""))

        dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName
        If dlgSaveAs.Show = -1 Then
        strCurrentFile = dlgSaveAs.SelectedItems(1)
        If Right(strCurrentFile, 4) <> ".pdf" Then
        Response = MsgBox("Sorry, only saving in the pdf-format is supported." & _
        vbNewLine & vbNewLine & "Save as pdf instead?", vbInformation + vbOKCancel)

        If Response = vbCancel Then
        wrdDoc.Close 0
        If bStarted Then wrdApp.Quit
        Exit Sub

        ElseIf Response = vbOK Then
        intPos = InStrRev(strCurrentFile, ".")

        If intPos > 0 Then
        strCurrentFile = Left(strCurrentFile, intPos - 1)
        End If

        strCurrentFile = strCurrentFile & ".pdf"
        End If
        End If

        wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        strCurrentFile, _
        ExportFormat:=17, _
        OpenAfterExport:=False, _
        OptimizeFor:=0, _
        Range:=0, _
        From:=0, _
        To:=0, _
        Item:=0, _
        IncludeDocProps:=True, _
        KeepIRM:=True, _
        CreateBookmarks:=0, _
        DocStructureTags:=True, _
        BitmapMissingFonts:=True, _
        UseISO19005_1:=False

        End If
        Set dlgSaveAs = Nothing

        wrdDoc.Close

        If bStarted Then wrdApp.Quit

        Set MyOlNamespace = Nothing
        Set MySelectedItem = Nothing
        Set wrdDoc = Nothing
        Set wrdApp = Nothing
        Set oRegEx = Nothing
    End Sub



    Sub Sort_Conversation_ID()
        MapSht.Sort.SortFields.Clear
        MapSht.Sort.SortFields.Add Key:=Range("E2:E65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        MapSht.Sort.SortFields.Add Key:=Range("G2:G65000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        MapSht.Sort.SortFields.Add Key:=Range("I2:I65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With MapSht.Sort
            .SetRange Range("C1:J65000")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End Sub
     
    Last edited: Jan 31, 2019
  11. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,
    Please see attached file for code.

    Attached Files:

  12. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,

    Can anyone please help me in this.
  13. vletm

    vletm Excel Ninja

    Messages:
    4,793
    ThrottleWorks likes this.
  14. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi @vletm sir,
    Thanks a lot for the help. Please give me some time to revert.
    Have a nice day ahead. :)
  15. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi @vletm sir,

    If we change To:=0 to To:=1 or any other number than 0
    Then I am getting below bug
    'The remote server machine does not exist or is unavailable’

    Please note, even if we do not do any change to line ‘To:=0’
    First fille is getting saved in the folder without any problem.

    However I am facing issues in the code from the second instance of the loop.
    This is happening with and without changing ‘To:=0’.
    Also, even if the first email is getting saved, pictures are cropped in PDF.

    I am afraid, even if this bug gets resolved, I might not be able to use this code.
    Since the picture is getting cropped I can not use this code.
    Can anyone please help me in this.
    Please see attached file for code.



    Attached Files:

    Last edited: Feb 4, 2019
  16. vletm

    vletm Excel Ninja

    Messages:
    4,793
    ThrottleWorks
    Did You read my reply?
    Did You check that syntax? ... no?
    Did You read about range? ... no?
    Did You set range as ExportFromTo? ... no?
    Are all other parameters as written in syntax?

    ... and of course,
    I cannot test that code at all!
    But that was one case,
    which not match with syntax.
    ThrottleWorks likes this.
  17. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi @vletm sir, my apologies, have a nice day ahead. :)
  18. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,

    I am using below mentioned code.

    This code is exporting only first e-mail from the loop.

    I am able to generate summary for all the e-mails from the folder.

    Even MHT files are getting saved correctly.

    For example, I have 8 e-mails in the folder.

    My list is getting updated for all the 8 e-mails.

    8 MHT files are saved. However only first PDF is getting saved.

    There is no bug, but files are not getting exported.

    Can anyone please help me in this.

    Code (vb):
    Option Explicit
    'https://stackoverflow.com/questions/51655911/export-outlook-email-as-pdf
    Sub OutLook_Export_2()
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.StatusBar = "Please wait, macro in progess !"
        Dim MyOutlook As Outlook.Application
        Dim wrdApp As Word.Application
        Dim wrdDoc As Word.Document
        Dim FSO As Object, TmpFolder As Object
        Dim sName As String
        Dim ONS As Outlook.Namespace
        Dim MYFOLD As Outlook.Folder
        Dim OMAIL As Object
        Dim R As Long
        Dim ListSht As Worksheet
        Dim WshShell As Object
        Dim SpecialPath As String
        Dim strToSaveAs As String
        Dim J As Variant
        Dim TmpFileName As Variant
        Dim MyDocs As Variant
        Dim MapSht As Worksheet
        Dim TempLr As Long
        Set MapSht = ThisWorkbook.Worksheets("Mapping")
        On Error Resume Next
        Set wrdApp = CreateObject("Word.Application")
        Set MyOutlook = New Outlook.Application
        Set ONS = MyOutlook.GetNamespace("MAPI")
        Set ONS = MyOutlook.PickFolder
        'Set MYFOLD = ONS.GetDefaultFolder(olFolderInbox)
       Set MYFOLD = ONS.PickFolder
        Set OMAIL = MyOutlook.CreateItem(olMailItem)
        Set ListSht = ThisWorkbook.Worksheets("List")
        Dim MyCount As Long
        MyCount = 0
        For Each OMAIL In MYFOLD.Items
            TempLr = MapSht.Cells(MapSht.Rows.Count, 3).End(xlUp).Row + 1
            MapSht.Cells(TempLr, 3).Value = TempLr - 1
            MapSht.Cells(TempLr, 4).Value = OMAIL.Subject
            MapSht.Cells(TempLr, 5) = OMAIL.ConversationID 'E Conversation ID
           MapSht.Cells(TempLr, 6) = OMAIL.ConversationTopic 'F Conversation Topic
           MapSht.Cells(TempLr, 7) = OMAIL.ReceivedTime 'G Received Time
           MapSht.Cells(TempLr, 8) = OMAIL.To 'H To
           MapSht.Cells(TempLr, 9) = OMAIL.Sender 'I From
           MapSht.Cells(TempLr, 10) = Now 'J Run time
           MyCount = MyCount + 1
            Set FSO = CreateObject("Scripting.FileSystemObject")
            Set TmpFileName = MapSht.Range("A2")
            sName = Left(OMAIL.Subject, 60) & "_" & MyCount
            ReplaceCharsForFileName sName, "-"
            TmpFileName = TmpFileName & "\" & sName & ".mht"
            OMAIL.SaveAs TmpFileName, olMHTML
            MapSht.Cells(TempLr, 11) = TmpFileName
            Set wrdDoc = wrdApp.Documents.Open(Filename:=TmpFileName, Visible:=True)
            Set WshShell = CreateObject("WScript.Shell")
            MyDocs = MapSht.Range("A2").Value
            strToSaveAs = MyDocs & "\" & sName & ".pdf"
            MapSht.Cells(TempLr, 12) = strToSaveAs
            If FSO.FileExists(strToSaveAs) Then
                sName = sName & Format(Now, "hhmmss")
                strToSaveAs = MyDocs & "\" & sName & ".pdf"
            End If
            wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
            strToSaveAs, ExportFormat:=wdExportFormatPDF, _
            OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
            Range:=wdExportAllDocument, From:=0, To:=0, Item:= _
            wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
            BitmapMissingFonts:=True, UseISO19005_1:=False
            wrdDoc.Close
            wrdApp.Quit
            Set wrdDoc = Nothing
            Set wrdApp = Nothing
            Set WshShell = Nothing
        Next OMAIL
        MyCount = 0
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.StatusBar = False
        MsgBox "Done!"
    End Sub
    'This function removes invalid and other characters from file names
    Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
        sName = Replace(sName, "/", sChr)
        sName = Replace(sName, "\", sChr)
        sName = Replace(sName, ":", sChr)
        sName = Replace(sName, "?", sChr)
        sName = Replace(sName, Chr(34), sChr)
        sName = Replace(sName, "<", sChr)
        sName = Replace(sName, ">", sChr)
        sName = Replace(sName, "|", sChr)
        sName = Replace(sName, "&", sChr)
        sName = Replace(sName, "%", sChr)
        sName = Replace(sName, "*", sChr)
        sName = Replace(sName, " ", sChr)
        sName = Replace(sName, "{", sChr)
        sName = Replace(sName, "[", sChr)
        sName = Replace(sName, "]", sChr)
        sName = Replace(sName, "}", sChr)
        sName = Replace(sName, "!", sChr)
    End Sub
     

    Attached Files:

    Last edited: Feb 8, 2019
  19. vletm

    vletm Excel Ninja

    Messages:
    4,793
    ThrottleWorks
    Do variable strToSaveAs get always (eight times) unique value?
    Have You verified that?
    ThrottleWorks likes this.
  20. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi @vletm sir, thanks for the help.
    I am getting unique values for all the 8 times.
    Infact all the MHT files are saved with correct names.

    Have a nice day ahead. :)
    Last edited: Feb 8, 2019
  21. vletm

    vletm Excel Ninja

    Messages:
    4,793
    ThrottleWorks
    ... if You'll again try to 'saveas' PDF pages from 0 to 0 ... hmm?
    ... how many pages would You save? .. ∞?
    ThrottleWorks likes this.
  22. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    Hi,
    I am trying to export word document to pdf with below code.
    The code runs without any error but file is not saved at the path.

    I tried halting this code after word file is generated and recorded file exporting task in word file.

    Copied same part and trying in excel but no success. Can anyone help me in this please.
    I guess I am facing problem at "ChangeFileOpenDirectory "C:\Users\abc123\Desktop\"
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    "C:\Users\abc123\Desktop\Test .pdf"' this part.

    Code (vb):
    Option Explicit

    'https://stackoverflow.com/questions/51655911/export-outlook-email-as-pdf
    Sub OutLook_Export_2()
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.StatusBar = "Please wait, macro in progess !"
        Dim MyOutlook As Outlook.Application
        Dim wrdApp As Word.Application
        Dim wrdDoc As Word.Document
        Dim FSO As Object, TmpFolder As Object
        Dim sName As String
        Dim ONS As Outlook.Namespace
        Dim MYFOLD As Outlook.Folder
        Dim OMAIL As Object
        Dim R As Long
        Dim ListSht As Worksheet
        Dim WshShell As Object
        Dim SpecialPath As String
        Dim strToSaveAs As String
        Dim J As Variant
        Dim TmpFileName As Variant
        Dim MyDocs As Variant
        Dim MapSht As Worksheet
        Dim TempLr As Long
        Call MyFolderPath
        Set MapSht = ThisWorkbook.Worksheets("Mapping")
        On Error Resume Next
        Set wrdApp = CreateObject("Word.Application")
        Set MyOutlook = New Outlook.Application
        Set ONS = MyOutlook.GetNamespace("MAPI")
        Set ONS = MyOutlook.PickFolder
        'Set MYFOLD = ONS.GetDefaultFolder(olFolderInbox)
       Set MYFOLD = ONS.PickFolder
        Set OMAIL = MyOutlook.CreateItem(olMailItem)
        Set ListSht = ThisWorkbook.Worksheets("List")
        Dim MyCount As Long
        MyCount = 0
        '
       Dim objMail As Outlook.MailItem
        Dim strFileName As String
        Dim strWordDocument As String
        Dim objWordApp As Word.Application
        Dim objWordDocument As Word.Document
        Dim objDocumentRange As Word.Range
        '
       For Each OMAIL In MYFOLD.Items
            TempLr = MapSht.Cells(MapSht.Rows.Count, 3).End(xlUp).Row + 1
            MapSht.Cells(TempLr, 3).Value = TempLr - 1
            MapSht.Cells(TempLr, 4).Value = OMAIL.Subject
            MapSht.Cells(TempLr, 5) = OMAIL.ConversationID 'E Conversation ID
           MapSht.Cells(TempLr, 6) = OMAIL.ConversationTopic 'F Conversation Topic
           MapSht.Cells(TempLr, 7) = OMAIL.ReceivedTime 'G Received Time
           MapSht.Cells(TempLr, 8) = OMAIL.To 'H To
           MapSht.Cells(TempLr, 9) = OMAIL.Sender 'I From
           MapSht.Cells(TempLr, 10) = Now 'J Run time
           MyCount = MyCount + 1
            On Error Resume Next
            Set objMail = OMAIL
            strFileName = Replace(objMail.Subject, "/", " ")
            strFileName = Replace(strFileName, "\", " ")
            strFileName = Replace(strFileName, ":", "")
            strFileName = Replace(strFileName, "?", " ")
            strFileName = Replace(strFileName, Chr(34), " ")
            strWordDocument = Environ("Temp") & "\" & strFileName & ".doc"
            objMail.SaveAs strWordDocument, olDoc
            Set objWordApp = CreateObject("Word.Application")
            Set objWordDocument = objWordApp.Documents.Open(strWordDocument)
            objWordApp.Visible = True
            If objWordApp.Selection.PageSetup.Orientation = wdOrientPortrait Then
                objWordApp.Selection.PageSetup.Orientation = wdOrientLandscape
            End If
            Dim MyFileName As String
            MyFileName = Left(OMAIL.Subject, 30)
            ChangeFileOpenDirectory "C:\Users\abc123\Desktop\"
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
            "C:\Users\abc123\Desktop\Test .pdf" _
            , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
            wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
            Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
            BitmapMissingFonts:=True, UseISO19005_1:=False
            objWordApp.Quit
        Next OMAIL
        MyCount = 0
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.StatusBar = False
        MsgBox "Done!"
    End Sub

     

    Attached Files:

  23. vletm

    vletm Excel Ninja

    Messages:
    4,793
    ThrottleWorks
    1) As this seems to be 'now' Cross-posted, it would be good to let us know that.
    2) Have You tested WITHOUT those spaces Test .pdf"?
    Screenshot 2019-02-11 at 18.04.37.png
    3) Your previous version had always different name for PDF.
    Now, You have FIXED filename for PDF.
    So, so how many different PDFs would create ... if You use FIXED filename?
    ThrottleWorks likes this.
  24. ThrottleWorks

    ThrottleWorks Excel Ninja

    Messages:
    1,946
    1) Hi @vletm sir, no, it is not cross posted by me.
    Else I would have informed in original post.

    2) Yes, have tested with original name, but facing same issue.

    3) Fixed file name is for testing purpose.
    Original macro has real path and real file name but macro is not saving even single file.

    Thanks for the help. Have a nice day ahead. :)
  25. vletm

    vletm Excel Ninja

    Messages:
    4,793
    ThrottleWorks
    ... after modify those
    ... many times helps if Quit Excel
    and one minute later Open it again.
    Quit means Quit (not close)!

    Next ...
    Why do You have 'all possible' parameters?
    Could You even try to use 'only' next? (( to Filename, You should use Yours ))
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=mystr, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    After those ... add needed ONE-by-ONE.
    Last edited: Feb 11, 2019
    ThrottleWorks likes this.

Share This Page