The below code will convert email message to PDF . I need the code now to save attachments in Word format to PDF in a folder . Can anyone please help me in this?
Sub SaveEmailMessages()


Dim objOL As Object, MyOlSelection As Outlook.Selection
Dim MyOlNamespace As Outlook.NameSpace
Set MyOlNamespace = Application.GetNamespace("MAPI")
Set MyOlSelection = Application.ActiveExplorer.Selection


Call SaveAsPDFfile(MyOlSelection)


Set MyOlSelection = Nothing
Set objOL = Nothing
End Sub
Sub SaveAsPDFfile(pobjSelection As Outlook.Selection)


Dim objOL As Object, MyOlSelection As Outlook.Selection
Dim xMail As Outlook.MailItem
On Error Resume Next


' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set MyOlSelection = pobjSelection


    Dim StrSaveFilename As String
    'Make sure at least one item is selected
    If MyOlSelection.Count = 0 Then
       Response = MsgBox("Please select an email", vbExclamation, "Save as PDF")
       Exit Sub
    End If
' Now loop through all selected emails
For Each xMail In MyOlSelection
    'Get all selected items
    'Retrieve the selected item
    'Set MySelectedItem = MyOlSelection.Item(1)
    
    'Get the user's TempFolder to store the item in
    Dim fso As Object, TmpFolder As Object
    Set fso = CreateObject("scripting.filesystemobject")
    Set tmpFileName = fso.GetSpecialFolder(2)
    
    'construct the filename for the temp mht-file
    strName = "www_howto-outlook_com"
    tmpFileName = tmpFileName & "\" & strName & ".mht"
    
    'Save the mht-file
    xMail.SaveAs tmpFileName, olMHTML
    
    'Create a Word object
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    
    'Open the mht-file in Word without Word visible
    Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=False)
    
    'Define the SafeAs dialog
    Dim dlgSaveAs As FileDialog
    Set dlgSaveAs = wrdApp.FileDialog(msoFileDialogSaveAs)
    
    'Determine the FilterIndex for saving as a pdf-file
    'Get all the filters
    Dim fdfs As FileDialogFilters
    Dim fdf As FileDialogFilter
    Set fdfs = dlgSaveAs.Filters


    'Loop through the Filters and exit when "pdf" is found
    Dim I As Integer
    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
    
    'Set the FilterIndex to pdf-files
    dlgSaveAs.FilterIndex = I
    
    'Get location of My Documents folder
    Dim WshShell As Object
    Dim SpecialPath As String
    Set WshShell = CreateObject("WScript.Shell")
    SpecialPath = WshShell.SpecialFolders(16)
    
    'Construct a safe file name from the message subject
    Dim msgFileName As String
    
    msgFileName = xMail.Subject


    Set oRegEx = CreateObject("vbscript.regexp")
    oRegEx.Global = True
    oRegEx.Pattern = "[\/:*?""<>|]"
    msgFileName = Trim(oRegEx.Replace(msgFileName, ""))
    
    'Set the initial location and file name for SaveAs dialog
    Dim strCurrentFile As String
  '  dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName
    StrSaveFilename = Trim(oRegEx.Replace(xMail.Subject, ""))
    StrSaveFilename = Left(StrSaveFilename, 50)
    StrSaveFilename = StrSaveFilename & Format(Time(), "hh-mm-ss") & ".pdf"
    dlgSaveAs.InitialFileName = "U:\Aman\Martin Oulook\Word\" & StrSaveFilename
    'xMail.SaveAsFile "U:\Aman\Martin Oulook\Word\" & StrSaveFilename
    
    'Show the SaveAs dialog and save the message as pdf
    If dlgSaveAs.Show = -1 Then
        strCurrentFile = dlgSaveAs.SelectedItems(1)
        
        'Verify if pdf is selected
        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
                    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
        
        'Save as pdf
        wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        strCurrentFile, 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
    
    End If
    Set dlgSaveAs = Nothing
    
    ' close the document and Word
    wrdDoc.Close
    wrdApp.Quit
    xMail.Categories = ""
    xMail.FlagStatus = olFlagComplete
    xMail.UnRead = False
    xMail.Save
Next
    'Cleanup
    Set MyOlNamespace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    Set oRegEx = Nothing


End Sub