Assign e-mail address based on PDF name from outlook attachment

[Cekaay]

Hi all,
my name is Constantin and I am mostly guest reading in this forum. Thanks for alle the help so far.
At the moment I am trying set up a macro to send different PDFs automatically to different recipients.
I have a Folder with all pdfs in it and a Excel list with filename and a corresponding E-Mail address. So far I achieved to the following Code:

Sub send_pdf()
Dim Nachricht As Object, OutlookApplication As Object
Set OutlookApplication = CreateObject("Outlook.Application")
Dim olOldBody As String
Dim Datei As String
Dim folder As String, pfile As String, ext As String
folder = "xxx\ZZZ_Umsätze\"
pfile = Dir(folder & "\*.*")
Do While CBool(Len(pfile))
    ext = Chr(32) & LCase(Trim(Right(Replace(pfile, Chr(46), Space(99)), 99))) & Chr(32)
    If CBool(InStr(1, " pdf ", ext, vbTextCompare)) Then
     Set Nachricht = OutlookApplication.CreateItem(0)
        With Nachricht
            .GetInspector.Display
            .Subject = "turnover 2017"
            olOldBody = .htmlBody
            .Attachments.Add (folder & "\" & pfile)
            .Display
            .To = ""
        End With
    
    End If
    pfile = Dir
Loop
End Sub

By running the Code Outlook automatically opens different E-Mail Messages with a single PDF.

Now I would like to assign a specific E-Mail address, which should be searched based on the PDF filename.
I have tried the following:

Application.WorksheetFunction.VLookup(FileName, Tabelle1.Range("A1:B350"), 2, False)

Unfortunately it is not working.

Can anybody please help me?

Thanks,
Constantin

 

[Worf]

Hi Constantin

Sub send_pdf()
' column A contains entries such as "graph theory.pdf"


Dim Nachricht As Object, OutlookApplication As Object
Set OutlookApplication = CreateObject("Outlook.Application")
Dim olOldBody As String, folder$, pfile$, ext$
folder = "c:\pub\client"
pfile = Dir(folder & "\*.*")
Do While CBool(Len(pfile))
    ext = Chr(32) & LCase(Trim(Right(Replace(pfile, Chr(46), Space(99)), 99))) & Chr(32)
    If CBool(InStr(1, " pdf ", ext, vbTextCompare)) Then
        Set Nachricht = OutlookApplication.CreateItem(0)
        With Nachricht
            .GetInspector.Display
            .Subject = "turnover 2017"
            olOldBody = .HTMLBody
            .Attachments.Add (folder & "\" & pfile)
            .Display
            .To = Application.WorksheetFunction.VLookup(pfile, Plan3.[a1:b35], 2, False)
        End With
    End If
    pfile = Dir
Loop
End Sub

 

[Cekaay]

Tested and working!

Thank you very much !!!

 

[Worf]

You are welcome and thanks for the feedback!