Before answering your question, some comments on your existing code.
You are running this code within Outlook. You do not need olApp. You only need a reference to the Outlook application if you are trying to access your emails from Excel or some other Office product.
I am surprised how often I see On Error GoTo ErrorHandler because I have never found a use from this statement.
If I am coding for myself, I want execution to stop on the statement causing the problem so I can understand what is happening without guessing from the error message. If execution stops on the statement causing the error, I can restart the code if I can immediately fix the error.
If I am developing for a client, I want, at worst, a user-friendly message. Err.Number & " - " & Err.Description is not my idea of a user-friendly message. It does not even tell me which email caused the problem. For a client, I would have something like:
Dim ErrDesc as String
Dim ErrNum as Long
: : :
On Error Resume Next
Statement that might give an error
ErrNum = Err.Num
ErrDesc = Err.Description
On Error GoTo 0
If ErrNum <> 0 Then
Code to handle errors that can occur with
this statement in a user-friendly manner.
End If
Today Dim Att As String is fine because you remember what Att is. Will you remember when you update this macro in six or twelve months? Will a colleague updating this macro know what Att is? I would call it AttName or perhaps AttDsplName.
You say the code saves PDF attachments but you do not check for this. To a VBA macro, logos, images, signatures and other files are also attachments. Also you assume the attachment you wish to save is Attachments(1). If there are several attachments, the logos, images and signatures could come first.
You have:
'Set folder to save in.
Dim olDestFldr As Outlook.MAPIFolder
You do not set olDestFldr and you do not move the email to a different folder. Do you want to do this?
Now to your question. I have included the code for two methods of achieving your objective and I discuss another two methods. However, before showing you the code, I suspect I need to introduce you to Variants. Consider:
Dim A As Long
Dim B As String
Dim C As Double
Dim D As Variant
I have declared A to C as a long integer, a string and a double. These variables can never be anything else and must be used in accordance with the rules for their type. I can write A = A + 1 or A = A * 5. Providing the new value for A does not exceed the maximum value for a long integer, these statements are fine. But I cannot write A = "House" because "House" is not an integer. I can write B = "House" because "House" is a string. I can write B = "5" and then A = A + B because VBA will perform implicit conversions if it can. That is, VBA can convert string "5" to integer 5 and add it to A.
I can also write:
D = 5
D = D + A
D = "House"
D is a Variant which means it can hold any type of data. Here I assign 5 to D then add A so for these two statements, D is holding an integer. I then change my mind and assign a string to D. This is not very sensible code but it is valid code. D can hold much more than an integer and a string. In particular, it can hold an array. Consider:
ReDim D(0 To 2)
D(0) = "House"
D(1) = A + 5
D(2) = 3.7
Following the ReDim statement, it is as though D has been converted to an array and I use array syntax to access the elements of D. D(0) contains "House", D(1) contains 5 more than the current value of A and D(2) contains double 3.7.
I can achieve the same effect with:
D = Array("House", A + 5, 3.7)
I am sure you agree this is easier. Array is a function that can take a large number of parameters and returns a Variant array containing those parameters which I have assigned to D. I do not normally advise mixing types within a variant array since it is very easy to get yourself into a muddle. However, it is valid VBA and I have found it invaluable with particularly difficult problems. Normally, I would not use function Array, I would write:
D = VBA.Array("House", A + 5, 3.7)
With VBA.Array, the lower bound of the array is guaranteed to be zero. With Array, the lower bound depends on the Option Base statement. I have never seen anyone use the Option Base statement, but I do not like to risk having my code changed by someone adding this statement. Search for “VBA Option Base statement” to discover what this statement does.
The following code demonstrates my first method of achieving your objective:
Option Explicit
Sub Method1()
Dim DiscFldrCrnt As Variant
Dim DiscFldrs As Variant
Dim Inx As Long
Dim SenderNameCrnt As Variant
Dim SenderNames As Variant
Dim SubjectCrnt As Variant
Dim Subjects As Variant
SenderNames = VBA.Array("Doe, John", "Early, Jane", "Friday, Mary")
Subjects = VBA.Array("John's topic", "Jane's topic", "Mary's topic")
DiscFldrs = VBA.Array("DoeJohn", "EarlyJane", "FridayMary")
For Inx = 0 To UBound(SenderNames)
SenderNameCrnt = SenderNames(Inx)
SubjectCrnt = Subjects(Inx)
DiscFldrCrnt = DiscFldrs(Inx)
' Code to process SenderNameCrnt, SubjectCrnt and DiscFldrCrnt
Debug.Print SenderNameCrnt & " " & SubjectCrnt & " " & DiscFldrCrnt
Next
End Sub
If you copy this code to a module, you can run it and see what it does. If you work slowly through it, you should be able to understand what it is doing. Come back with questions if necessary but the more you can discover for yourself, the faster you will develop your own skills.
Note: the disc folders have names such as “DoeJohn”. I am assuming you would have something like "C:\Users\NAEC02\Test\" as a root folder and you would save the attachment to "C:\Users\NAEC02\Test\DoeJohn\".
I use this method when I have a small number of values I need to link. It relies on SenderNames(#), Subjects(#) and DiscFldrs(#) being associated. As the number of different combinations increase, it can be difficult to keep the three arrays in step. Method2 solves that problem.
Sub Method2()
Dim DiscFldrCrnt As Variant
Dim Inx As Long
Dim SenderNameCrnt As Variant
Dim SubjectCrnt As Variant
Dim TestValues As Variant
TestValues = Array("Doe, John", "John's topic", "John", _
"Early, Jane", "Jane's topic", "Jane", _
"Friday, Mary", "Mary's topic", "Mary")
For Inx = LBound(TestValues) To UBound(TestValues) Step 3
SenderNameCrnt = TestValues(Inx)
SubjectCrnt = TestValues(Inx + 1)
DiscFldrCrnt = TestValues(Inx + 2)
' Code to process SenderNameCrnt, SubjectCrnt and DiscFldrCrnt
Debug.Print SenderNameCrnt & " " & SubjectCrnt & " " & DiscFldrCrnt
Next
End Sub
Here I have placed all the values in a single array. If I want to add a new sender, I add another three elements to the end of the array which I find this easier to manage. For the code to process the three values, Method1 and Method2 are identical.
The principle disadvantage of Method2 compared with Method1 is that the total number of values is reduced. I like to see all my code so I do not like statements that exceed the width of the screen. This limits my lines to about 100 characters. I use the continuation character to spread the statement over several lines but there is a maximum of 24 continuation lines per statement. With Method1, I am spreading the values over three arrays and therefore three statements so I can have three times as many values. In practice this is not a real limit. Both Method1 and Method2 become too difficult to manage before the VBA limits are reached.
The real disadvantage of Method1 and Method2 is that every change requires the services of a programmer. If user maintenance is important, I use Method3 which reads a text file into arrays or Method4 which reads from an Excel worksheet. I have not included code for either Method3 or Method4 but can add one or both if you need this functionality. I find most users prefer a worksheet but those with a favourite text editor prefer a text file.
In the middle of both Method1 and Method2 I have:
' Code to process SenderNameCrnt, SubjectCrnt and DiscFldrCrnt
Debug.Print SenderNameCrnt & " " & SubjectCrnt & " " & DiscFldrCrnt
You need to replace these statements with a variation of your existing code. I have no easy method of testing the following code so it is untested but it should give you are start.
This is a new version of Items_ItemAdd designed to work with either of my methods.
Private Sub Items_ItemAdd(ByVal Item As Object)
Const DiscFldrRoot As String = "C:\Users\NAEC02\Test\"
' * There is no need to write Outlook.MailItem because (1) you are within Outlook
' and (2) there is no other type of MailItem. You only need to specify Outlook
' for folders since there are both Outlook and Scripting folders. Note:
' "Scripting" is the name of the library containing routines for disc folders.
' * Do not spread your Dim statements throughout your sub. There are languages
' where you can declare variables within code blocks but VBA is not one of those
' languages. With VBA, you can declare variables for an entire sub or function,
' for an entire module or for an entire workbook. If you spread your Dim
' statements out it just makes them hard to find and you are still declaring
' them at the module level.
Dim DiscFldrCrnt As Variant
Dim InxA As Long
Dim Msg As MailItem
Dim SenderNameCrnt As Variant
Dim SubjectCrnt As Variant
' You also need the arrays from whichever of Method1 or Method2 you have chosen
If TypeName(item) = "MailItem" Then
' Only interested in MailItems
Set Msg = Item
' Code from Method1 or Method2 with the code below in the middle
End If
End Sub
Insert the body of Method1 or Method2, whichever you chose, in the middle of the above code. Then insert the following code in the middle of that code.
With Msg
If .Attachments.Count = 0 Then
' Don't bother to check MailItem if there are no attachments
Else
If .Subject <> SubjectCrnt Then
' Wrong subject so ignore this MailItem
ElseIf .SenderName <> SenderNameCrnt Then
' Wrong sender name so ignore this MailItem
Else
' SenderName and Subject match so save any PDF attachments
For InxA = 1 to .Attachments.Count
If LCase(Right$(.Attachments(InxA).DisplayName, 4)) = ".pdf" Then
' Warning: SaveAsFile overwrites existing file with the same name
.Attachments(InxA).SaveAsFile DiscFldrRoot & DiscFldrCrnt & _
.Attachments(InxA).DisplayName
End If
End With
Next
End If
End With
