CODEWITHSUNDEEP
regexvbaoutlook
iamgda
iamgda

Reputation: 13

How to get specific word in an Email thanks to regex and insert that word in a file name with Outlook VBA?

I would like to get specific word inside an Email (should be the signature of the Email) and store that word in a file name thanks to Outlook VBA.

I already have something that work to add the date in the file name but I would like to add the name (from the signature) from whom the Email has been sent.

This is the part that already work:

Public Sub Process_SAU(Item As Outlook.MailItem)

Dim object_attachment As Outlook.Attachment
 
Dim saveFolder As String
' Folder location when I want to save my file
saveFolder = "C:\Users\gdeange1\Desktop\suggestion updates\UpdateBusinessInformation\Processed_By_Bulks"
       For Each object_attachment In Item.Attachments
' Criteria to save .doc files only
    If InStr(object_attachment.DisplayName, ".json") Then
 
        object_attachment.SaveAsFile saveFolder & "\" & Format(Now(), "dd-mm-yyyy") & "_" & object_attachment.DisplayName

    End If
 
    Next

End Sub

And I found something that could do the trick:

Function ExtractText(Str As String) ' As String
 Dim regEx As New RegExp
 Dim NumMatches As MatchCollection
 Dim M As Match
 
'this pattern looks for 4 digits in the subject
 regEx.Pattern = "((.*))[A-Z]{0}(Danièle Loubert|Véronique Mantha|Julie-Emmanuelle Carle|Nicolas Bertrand|Martine Jean)"

' use this if you need to use different patterns.
' regEx.Pattern = regPattern

 Set NumMatches = regEx.Execute(Str)
 If NumMatches.Count = 0 Then
      ExtractText = ""
 Else
 Set M = NumMatches(0)
     ExtractText = M.SubMatches(0)
 End If
 code = ExtractText
End Function

I tried something like this :

Public Sub Process_SAU(Item As Outlook.MailItem)
 
Function ExtractText(Str As String) ' As String
 Dim regEx As New RegExp
 Dim NumMatches As MatchCollection
 Dim M As Match
 
'this pattern looks for 4 digits in the subject
 regEx.Pattern = "((.*))[A-Z]{0}(Danièle Loubert|Véronique Mantha|Julie-Emmanuelle Carle|Nicolas Bertrand|Martine Jean)"

' use this if you need to use different patterns.
' regEx.Pattern = regPattern

 Set NumMatches = regEx.Execute(Str)
 If NumMatches.Count = 0 Then
      ExtractText = ""
 Else
 Set M = NumMatches(0)
     ExtractText = M.SubMatches(0)
 End If
 code = ExtractText

Public Sub Process_SAU(Item As Outlook.MailItem)

Dim object_attachment As Outlook.Attachment
 
Dim saveFolder As String
' Folder location when I want to save my file
saveFolder = "C:\Users\gdeange1\Desktop\suggestion updates\UpdateBusinessInformation\Processed_By_Bulks"
       For Each object_attachment In Item.Attachments
' Criteria to save .doc files only
    If InStr(object_attachment.DisplayName, ".json") Then
 
        object_attachment.SaveAsFile saveFolder & "\" & Format(Now(), "dd-mm-yyyy") & "_" & code & "_" & object_attachment.DisplayName

    End If
 
    Next

End Function
End Sub

But I got an error : Compile Error -> Expected End Sub

Now can I mix both of these codes in order to have my file name something like this :

object_attachment.SaveAsFile saveFolder & "\" & Format(Now(), "dd-mm-yyyy") & "_" & code & "_" & object_attachment.DisplayName

That would give for example: 23-02-2021_Martine Jean_update.json (I'don't if the space has to be removed).

Thank you in advance for your help, really appreciate it!

G

UPDATED (Not sure that this work)

 Public Sub Process_SAU(Item As Outlook.MailItem)

Dim object_attachment As Outlook.Attachment
 
Dim saveFolder As String
Dim Code As Code
' Folder location when I want to save my file
saveFolder = "C:\Users\gdeange1\Desktop\suggestion updates\UpdateBusinessInformation\Processed_By_Bulks"
       For Each object_attachment In Item.Attachments
' Criteria to save .doc files only
    If InStr(object_attachment.DisplayName, ".json") Then
 
        object_attachment.SaveAsFile saveFolder & "\" & Format(Now(), "dd-mm-yyyy") & "_" & Code & "_" & object_attachment.DisplayName

    End If
 
    Next

End Sub

Function ExtractText(Str As String) ' As String
 Dim regEx As New RegExp
 Dim NumMatches As MatchCollection
 Dim M As Match

 regEx.Pattern = "((.*))[A-Z]{0}(Danièle Loubert|Véronique Mantha|Julie-Emmanuelle Carle|Nicolas Bertrand|Martine Jean)"



 Set NumMatches = regEx.Execute(Str)
 If NumMatches.Count = 0 Then
      ExtractText = ""
 Else
 Set M = NumMatches(0)
     ExtractText = M.SubMatches(0)
 End If
 Code = ExtractText
 End Function

Upvotes: 0

Views: 95

Answers (1)

urdearboy
urdearboy

Reputation: 14580

Functions and subs should be seperated into their own procedures. Here is an example where there is a main sub that calls a function. Note the sub passes the input to the function which ends up bringing the output to your sub.

Notice each macro stands alone. You do not nest the entire code for the function inside your main macro

Sub Master_Macro()

    Dim Output As Double

    'Call Function with Input

    'Work with output in current sub
    Output = Add_10(30)
    MsgBox Output

End Sub

Public Function Add_10(Target As Double) As Double

    'Takes a input (Target) and returns value + 10
    Add_10 = Target + 10

End Function

With the code you shared, start with the first macro and simply call the function while passing in the right parameter. From there, the idea you suggested would work.

Upvotes: 1

Related Questions