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

[Hwee Kian]

Hi Guys,

I need some help here please!. 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"

Is there any expert who could lend a hand and help me with my query please? I'm struggling quite a fair bit not knowing how to reference to an excel table from my outlook vba. 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

 

[BobBridges]

Rather than look carefully at your code, I'm just going to trust that it works (as you said it does) and suggest how I would go about finding the company code to add to the filename. I'm assuming there are a variable number of company names and codes in the table, and that you may want to process a lot of files. So rather than look up up each company in the other worksheet—which could slow down the program significantly—I would load Table.xls into a collection; after that each lookup would go much faster. Like this (just a sample):

Set owb = Workbooks.Open("Table.xls")
Set ows = owb.ActiveSheet
rZ = LastRow(ows, 1, 1) 'I have a LastRow function that finds the bottom row of a worksheet.
  'You can no doubt figure out your own preferred way of finding this value.
Set Companies = New Collection
For jr = 2 to rZ 'for each row in Tables.xls
  vn = ows.Cells(jr, 1).Value 'fetch the company name
  Set oco = New Obj2 'I frequently use a class I call Obj2 that has only two properties, Name
    'and Value, for casual use in cases just like this.  Again, you can probably figure out your
    'own way of handling this
  Companies.Add oco, vn 'add the new company to the collection
  oco.Name = vn
  oco.Value = ows.Cells(jr, 2).Value
  Next jr
owb.Close 'don't need the workbook any more

Now there's a collection named Companies that has all the company names and codes in it. The "key" to the collection is the company name. Later, when you're ready to look up a company code, it's pretty easy:

' Let's say the company name is in ThisCompany.
Set oco = Companies(ThisCompany)
CompanyCode = oco.Value

Of course there are all sorts of checks you'll want to add. For instance, if Table.xls has blank rows, you'll want to skip them when loading the table. And you'll want your program to check to be sure there are no duplicate values. And later on you want your program to notice (not to abend) if you try to look up a company name that isn't in the table. We can talk about those details, if you need to. But this is generally how it would work.