Update file names when the file names contain specific string referenced from an Excel table

Question

I have created a fully functional outlook macro, that downloads Outlook attachments to OneDrive specified folder.

So the macro would update the file name with the email domain and month/year

e.g.

from original attachment name "Invoice_GBR_Z-GRX_2019_07.pdf"

it becomes "comfone.com_08-2019___Invoice_GBR_Z-GRX_2019_07.pdf" after executing the macro.

However, I would like the macro to also have the ability to compare against a static Excel table called Table.xls on my desktop (2 columns where column A contain the email domain name, and column B containing its respective company code), wherein if the Excel cell contains "comfone.com", then its corresponding company code say 0001 would then be appended to the file name

So the file name gets updated to

"0001_comfone.com_08-2019___Invoice_GBR_Z-GRX_2019_07.pdf"

I'm struggling quite a fair bit not knowing how to reference to an Excel table from my Outlook vba.

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim saveName As String
Dim userName As String

Dim sndrEmailAdd As String
Dim sndrEmailRight As String
Dim sndrEmailPreDot As String


' Get the path to your OneDrive folder.
userName = CreateObject("WScript.Network").userName
Debug.Print userName
'strFolderpath = "C:\Users\" & VBA.Environ$("USERNAME") & "\OneDrive - SAP 
SE"
strFolderpath = "C:\Users\" & userName & "\OneDrive - SAP SE"
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the Test folder, change "Test" to any folder name in your OneDrive
strFolderpath = strFolderpath & "\Downloaded Invoices\"


' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder and strip them from the item.
For Each objMsg In objSelection

' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFiles = ""

If lngCount > 0 Then

    ' We need to use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.

    For i = lngCount To 1 Step -1

    'Extract text, after @ and before dot, from the email address.
    sndrEmailAdd = objMsg.SenderEmailAddress

    Debug.Print sndrEmailAdd
    'Debug.Print " position of @ sign: " & InStr(sndrEmailAdd, "@")
    'Debug.Print " number of characters right of @ sign: " & 
     Len(sndrEmailAdd) - InStr(sndrEmailAdd, "@")

    'sndrEmailRight = Right(sndrEmailAdd, Len(sndrEmailAdd) - 
    InStr(sndrEmailAdd, "@"))
    sndrEmailRight = Right(sndrEmailAdd, Len(sndrEmailAdd) - 
    InStr(sndrEmailAdd, "@"))
    Debug.Print " text after @ sign: " & sndrEmailRight

    Debug.Print " position of the (first) . period in the remaining text: 
    " & InStr(sndrEmailRight, ".")
    'sndrEmailPreDot = Left(sndrEmailRight, InStr(sndrEmailRight, ".") - 
    1)


        ' Save attachment before deleting from item.
        ' Get the file name.
        strFile = sndrEmailRight & "_" & Format(DateAdd("m", -1, 
        objMsg.ReceivedTime), "mm-yyyy") & "___" & 
        objAttachments.item(i).FileName

        ' Combine with the path to the Temp folder.
        saveName = strFolderpath & strFile

          ' Save the attachment as a file.
         objAttachments.item(i).SaveAsFile saveName

        ' Delete the attachment.
        'objAttachments.item(i).Delete



    Next i

    objMsg.Save

End If
Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Answer 1

See example on how to call Excel from Outlook

https://stackoverflow.com/a/41801050/4539709

I have updated your code, make sure to Reference to Microsoft Excel xx.x Object Library and update your one-drive folder path

Your code example

Option Explicit
Public Sub SaveAttachments()
    Dim Atmts As Outlook.Attachments
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strDeletedFiles As String
    Dim saveName As String
    Dim userName As String
    Dim sndrEmailAdd As String
    Dim sndrEmailRight As String
    Dim sndrEmailPreDot As String

    Dim strFolderpath As String
        strFolderpath = "C:\Temp\"

    ' Get the collection of selected objects.
    Dim objSelection As Outlook.Selection
    Set objSelection = Application.ActiveExplorer.Selection

    Dim xlApp As Excel.Application
    Set xlApp = New Excel.Application

    Dim Book As Workbook
    Set Book = xlApp.Workbooks.Open("C:\Temp\Book1.xlsx")

    Dim xlStarted As Boolean
        xlStarted = True

    Dim Sht As Excel.Worksheet
    Set Sht = Book.Sheets("Sheet1")

    Dim Rng As Range

    ' Check each selected item for attachments. If attachments exist,
    ' save them to the strFolderPath folder and strip them from the item.
    Dim objMsg As Outlook.MailItem 'Object
    For Each objMsg In objSelection

        ' This code only strips attachments from mail items.
        ' If objMsg.class=olMail Then
        ' Get the Attachments collection of the item.
        Set Atmts = objMsg.Attachments
        lngCount = Atmts.Count
        Debug.Print lngCount
        strDeletedFiles = ""

        If lngCount > 0 Then

            ' We need to use a count down loop for removing items
            ' from a collection. Otherwise, the loop counter gets
            ' confused and only every other item is removed.

            For i = lngCount To 1 Step -1

                'Extract text, after @ and before dot, from the email address.
                sndrEmailAdd = objMsg.SenderEmailAddress
                Debug.Print sndrEmailAdd

                sndrEmailRight = Right(sndrEmailAdd, Len( _
                                       sndrEmailAdd) - InStr( _
                                       sndrEmailAdd, "@"))

                Debug.Print sndrEmailRight

                sndrEmailPreDot = Left(sndrEmailRight, _
                                 InStr(sndrEmailRight, ".") - 1)

                Debug.Print sndrEmailPreDot

                For Each Rng In Sht.Range("A1", Sht.Range("A100").End(xlUp))
                    If (Rng.Value) = sndrEmailRight Then
                        sndrEmailPreDot = Rng.Offset(0, 1).Value & "_" & sndrEmailPreDot
                        Debug.Print sndrEmailPreDot
                    End If
                Next

                ' Save attachment before deleting from item.
                ' Get the file name.
                strFile = sndrEmailPreDot & "_" & _
                          Format(DateAdd("m", -1, objMsg.ReceivedTime _
                          ), "mm-yyyy") & "___" & Atmts.Item(i).FileName

                Debug.Print strFile

                ' Combine with the path to the Temp folder.
                saveName = strFolderpath & strFile
                Debug.Print saveName

                ' Save the attachment as a file.
                Atmts.Item(i).SaveAsFile saveName

                ' Delete the attachment.
                'Atmts.item(i).Delete

            Next i

            objMsg.Save

        End If
    Next

    ' Close & SaveChanges
    Book.Close SaveChanges:=True
    If xlStarted Then
        xlApp.Quit
    End If

    Set xlApp = Nothing
    Set Book = Nothing
    Set Sht = Nothing
    Set Rng = Nothing

    Set Atmts = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
End Sub