Detect new mail then extract, unzip and rename attachments - vba

Question

I receive 4 weekly emails from 3 different senders.
Emails 1 and 2 are from the same sender and can be recognized through VBA. These emails contain zip files, where each zip file has one .csv file.
Emails 3 and 4 can also be recognized by VBA and the attachments are Excel sheets (.xlsx).
I want to extract and unzip (where needed) and save these 4 files in a folder as; email1.report, email2.report etc.
Then make a copy of these 4 files in a different folder for each file and rename like; "Today's date".email1.report.csv etc.
I want to combine these steps in a single code and to replace the email1.report, email2.report etc., files without a prompt asking "do you want to replace the files? Yes, No?"
Is it possible to detect the new weekly emails and do this automatically?
The code I use to unzip and save:
Else
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 3) = "zip" Then
FileNameFolder = "C:\Users\..."
FileName = FileNameFolder & Left(Atmt.FileName, (InStr(1, Atmt.FileName, ".zip") - 1)) & ".txt"
Atmt.SaveAsFile FileName
FileNameT = FileNameFolder & Atmt.FileName
Name FileName As FileNameT
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((FileNameT)).Items
Kill FileNameT
i = i + 1
End If
Next Atmt
'item.Close
End If

Answer 1

I won't develop the code for your specific problem, but I recently wrote something similar. Maybe you can go from here by altering to your criteria etc.
In my case I had two e-mails incoming shortly after another, within 60 seconds. Both mails had "FP" in their subject and a .pdf-attachment. The task was to concatenate these attachments using the installed PDF24, which luckily offers a shell command for this.
This was the code, placed in the "ThisOutlookSession" of the Outlook VBA project explorer.
Public btAttachmentMails As Byte
Public dtArrivalStamp As Date
Public strPathFirstMailAttachment As String
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
Dim i As Integer
Dim strDocumentsFolder As String
strDocumentsFolder = CreateObject("WScript.Shell").SpecialFolders(16)
strPathFirstMailAttachment = strDocumentsFolder & "\attachment_mail1.pdf"
If Item.Subject Like "FP*" Then
If btAttachmentMails = 0 Then
'first mail -> save attachment and set counter to 1
btAttachmentMails = 1
dtArrivalStamp = Time
For i = 1 To Item.Attachments.Count
If InStr(Item.Attachments.Item(i).DisplayName, ".PDF") > 0 Then
Item.Attachments.Item(i).SaveAsFile strPathFirstMailAttachment
End If
Next i
ElseIf btAttachmentMails = 1 Then
Dim dtNow As Date: dtNow = Time
If TimeDiff(dtArrivalStamp, dtNow) <= 60 Then
'second mail within 60 seconds with subject containing "FP" -> save attachment and concatenate both via pdf24, then delete both files
'save attachment of second mail
Dim strPathSecondMailAttachment As String
strPathSecondMailAttachment = strDocumentsFolder & "\attachment_mail2.pdf"
For i = 1 To Item.Attachments.Count
If InStr(Item.Attachments.Item(i).DisplayName, ".PDF") > 0 Then
Item.Attachments.Item(i).SaveAsFile strPathSecondMailAttachment
End If
Next i
'concatenate pdf documents via pdf24 shell
Dim strOutputPath As String
strOutputPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Year(Date) & Month(Date) & Day(Date) & "_Wartungsplan_" & Replace(CStr(Time), ":", "-") & ".PDF"
Shell ("""C:\Program Files (x86)\PDF24\pdf24-DocTool.exe"" -join -profile ""default/good"" -outputFile " & strOutputPath & " " & strPathFirstMailAttachment & " " & strPathSecondMailAttachment)
'inform user
MsgBox ("Files have been successfully concatenated. You can find the combined file on your desktop.")
'reset status, delete temporary documents
btAttachmentMails = 0
If CreateObject("Scripting.FileSystemObject").fileexists(strPathFirstMailAttachment) Then Kill strPathFirstMailAttachment
If CreateObject("Scripting.FileSystemObject").fileexists(strPathSecondMailAttachment) Then Kill strPathSecondMailAttachment
Else
'second mail did not arrive within 60 seconds -> treat as first mail
'save new arrival time and overwrite old firstMailAttachment with this one
dtArrivalStamp = Time
For i = 1 To Item.Attachments.Count
If InStr(Item.Attachments.Item(i).DisplayName, ".PDF") > 0 Then
Item.Attachments.Item(i).SaveAsFile strPathFirstMailAttachment 'overwrites existing file
End If
Next i
End If
End If
End If
End If
ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description & " - please contact XY"
Resume ExitNewItem
End Sub
Function TimeDiff(StartTime As Date, StopTime As Date)
TimeDiff = Abs(StopTime - StartTime) * 86400
End Function

Answer 2

cr44sh has posted an answer while I was creating mine. He has recommended using a new item event while I have recommended using a rule. I prefer rules but you can choose which ever approach you favour.
It is impossible to fully answer your question but I believe I can give enough help for you to construct the macros you need yourself.
You say that these emails can be identified with VBA. That suggests the best approach is an Outlook rule which uses the “run a script” option where “run a script” means “run a macro”. I will discuss the rule later but first you need the macros that will be run.
You will need two macros like this:
Public Sub Type1Email(ByRef ItemCrnt As MailItem)
' Relevant code
End Sub
Public Sub Type2Email(ByRef ItemCrnt As MailItem)
' Relevant code
End Sub
I am sure you can create better names for these macros. I have read that macros to be run by a rule must be in ThisOutlookSession. In my experience, they can be in an ordinary module providing they are declared as Public. I only use ThisOutlookSession for code that has to be in that code area. If code can be in a module, that is where I place it. I suggest creating a new module which will be named Module1 or Module2. Use function key F4 to access its properties and rename it as “ModRuleMacros” or similar. Giving modules meaningful names makes it so much easier to find the code you want to look at today.
Although the aim is to create a macro to be run by a rule, you need a way of testing the macro. If you have some of these emails saved somewhere, you can activate the rule by moving one of those emails to Inbox. However, I generally find it easier to use a macro like this:
Sub TestType1Email()
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Pleaase select one or more emails then try again", vbOKOnly)
Exit Sub
Else
For Each ItemCrnt In Exp.Selection
Call Type1Email(ItemCrnt)
Next
End If
End Sub
To use this macro, you select one or more Type1 emails and then run macro TestType1Email. This macro will pass the selected emails, one at a time, to the macro Type1Email. This will allow you to single step through macro Type1Email and ensure that it works to your entire satisfaction. I find this to be the easier method of testing a new Outlook macro.
It may be helpful to check what a rule can do for you. Select one of these emails and then click on Rules, which is in the middle of the Home tab, and then Create rule …. Selecting one of these emails means the first window is filled out with some options. Click Advanced options …. The new window lists all the options for selecting an email. Are all the options you need to select a type 1 or a type 2 email listed? The list is comprehensive but not complete. For example, you cannot select by the presence of attachments. Identify the options you can use and identify the options you need that are missing. Click Cancel twice to exist from rule creation.
You will need include code for any missing options in your macro.
Your question implies you have all the code you need for processing the emails except for suppressing the replace question. You need to check if there is an existing file before creating the new file. This is the routine that I use to check if a file exists:
Public Function FileExists(ByVal PathName As String, ByVal FileName As String) As Boolean
' Returns True if file exists. Assumes path already tested.
' Coded by Tony Dallimore
' Based on code written by iDevlop: http://stackoverflow.com/a/28237845/973283
' Ensure only one "\" between path and filename
If Right$(PathName, 1) <> "\" Then
PathName = PathName & "\"
End If
If Left$(FileName, 1) = "\" Then
FileName = Mid$(FileName, 2)
End If
FileExists = False
On Error Resume Next
FileExists = ((GetAttr(PathName & FileName) And vbDirectory) <> vbDirectory)
On Error GoTo 0
End Function
If the file exists, you can:
Use VBA statement Kill (https://learn.microsoft.com/en-gb/office/vba/Language/Reference/user-interface-help/kill-statement) to delete the old file.
Use VBA statement Name (https://learn.microsoft.com/en-gb/office/vba/language/reference/user-interface-help/name-statement) to move the old file to another folder or rename it perhaps by adding a date at the beginning of the name.
I favour the second option because I do not like deleting a file until I am really, really sure I will not need it again. I saw too many situations during my career where a file deleted as no longer needed was found to be incorrectly or incompletely processed a few months later.
Once you have fully tested the macros, you can create the rules to execute them. For each type of email:
Select an email of the required type.
Click on Rules and then Create rule ….
Tick any relevant boxes on the first window.
Click Advanced options ….
Tick all relevant boxes on the second window.
Click Next.
Tick the box against “Run a script”.
Click a script.
You will be shown a list of all the macros that can be run from a rule. Select the required macro.
Click Next.
Tick the box against any appropriate exceptions and enter any additional information required.
Click Next.
Name the rule. Tick “run this rule against any messages already in Inbox” if required. Review the rule and edit if necessary.
Click Finish.
I hope the above is enough to plug the holes in your knowledge.