How to update file names when the file names contain specific string referenced from a table?

[weijianhk]

Hi Guys,

I need some help here. I have 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. "comfone.com_08-2019___Invoice_GBR_Z-GRX_2019_07.pdf"

However, I would like the macro to also have the ability to compare against a static excel table called Table.xls (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"

Is there any expert who could lend a hand and help me with my query please? Thanks a ton!

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

 

[ExcelGzh]

If you use this function

Function FnGetCompanyCode(EmailDomain As String) As String
  Dim myWorkBook As Workbook
  Set myWorkBook = Workbooks.Open("Table.xls")
  FnGetCompanyCode = Application.VLookup(EmailDomain, myWorkBook.Sheets("Sheet1").Range("A:B"), 2, False)
  Workbooks(WBFilename).Close
End Function

and combine it with your strFile variable

strFile = FnGetCompanyCode & "_" & strFile

That should be what you need