0
votes

I need to save attachments to a folder based on the sender.

I have a code that I copy and edit slightly for each contact in Outlook but I want to avoid doing this manually.

Each contact has their own subfolder and each subfolder name corresponds to the Full Name in Outlook.

Example Path: C:\Users\me\Dropbox\School\Academic\All students\John Smith

All paths are the same except for the Full Name, John Smith in the example, at the end.

Full Name is full name in Outlook Contacts and also the name of the subfolder.

I need a path with a variable that works for all contacts.

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oAttachment As Outlook.Attachment
    Dim sSaveFolder As String
    sSaveFolder = "C:\Users\me\Dropbox\School\Academic\All students\Full Name"
    For Each oAttachment In MItem.Attachments
    oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
    Next
End Sub
2
What contact are you talking about? Sender?Eugene Astafiev
@EugeneAstafiev contacts refers to My Contacts in Outlook.Eugene
How do you choose a contact from the My Contacts folder?Eugene Astafiev
@EugeneAstafiev I need a code that I can apply to all contacts and then run a script for all incoming mail. I don't need to choose a contact. They are already saved in Outlook.Eugene
You want someone to write code that searches the Contacts folder for the sender of an email and returns the corresponding Full Name?niton

2 Answers

0
votes

The subroutine in your question has a MailItem as a parameter. It is designed to be called by another routine that has decided that the MailItem should be examined and perhaps processed. Without that other routine, the routine you show cannot be used. I do not understand your question well enough to provide a solution. Instead I provide some background information and guidance which should be enough for you to construct the macro you want.

There are four distinct methods of selecting a MailItem for processing by a macro:

  1. The user selects one or more emails within a folder and then calls a macro to examine those emails.
  2. A routine scans up or down a known folder examining the MailItems within it.
  3. A rule selects an incoming email and the “Run a script” option specifies a macro to be run.
  4. A macro automatically run when Outlook is opened requests Outlook monitor a folder, such as Inbox, for new items and to run a particular a macro each time a new item arrives. “New Item” is one of a number of events which you can ask Outlook monitor.

Most of the time these four methods are completely independent; you must pick the one that best matches your current requirement and ignore the others. Having said that, I have used method 1 to select an email and have identified the folder containing that email as an easy way for the user to specify a folder for method 2. However, such opportunities to mix and match these four methods are rare.

I am guessing that students email you their homework which you want to drop into a disc folder named for that student. I suspect method 3 will be the most suitable.

Having identified an email, you want to check it against your contacts. It is not clear how you want to perform that check perhaps because you do not know what your options are.

If I do not know about a particular function, I will search for “Outlook VBA xxxxxxxx” using my favourite search engine. This typically brings up a lot of different websites. Probably one will be a Microsoft site and the rest will be tutorials or relevant questions from question/answer sites. I find the Microsoft site like a dictionary; it tells me the meaning of the word but not how to use it. The other sites are like novels which may contain a sentence that includes the word I want but does not give an explanation of the word. I normally have to look at some other sites to get a feel for the function and then look at the Microsoft site for the formal definitions.

Looking at the sites found for “Outlook VBA contacts”, I constructed this macro:

Option Explicit
Sub DemoContacts()

  Dim FldrContacts As Outlook.Folder
  Dim InxF As Long

  ' Session.GetDefaultFolder(olFolderContacts) returns the default folder for contacts.
  ' On my system, Outlook does not use the default folder.  I had to look at "My
  ' Contacts" where a list told me that it saved my contacts in "OutlookOutlook".
  ' Note: "OutlookOutlook" is the name of a store.  A store is disc file in which
  ' Outlook stores emails, task, contacts and so on.

  'Set FldrContacts = Session.GetDefaultFolder(olFolderContacts)
  Set FldrContacts = Session.Folders("OutlookOutlook").Folders("Contacts")

  For InxF = 1 To FldrContacts.Items.Count
    With FldrContacts.Items(InxF)
      Debug.Print .Email1DisplayName & "   " & .Email1Address
    End With
  Next

End Sub

The above macro displays two properties for every contact in the selected folder. There are many, many more properties but I selected the two that I thought were most likely to match your requirement. See https://docs.microsoft.com/en-us/office/vba/api/outlook.contactitem for a complete list of methods and properties.

The next macro, like yours, is designed to be called by another routine. I will discuss the calling routine later.

Public Sub OutSomeProperties(ItemCrnt As Outlook.MailItem)

  ' Outputs selected properties of a MailItem to the Immediate Window.

  ' The Immediate Window can only display about 200 rows before the older
  ' rows start scrolling off the top.  This means this routine is only
  ' suitable for displaying a small number of simple properties.  Add or
  ' remove properties as necessary to meet the current requirement.

  Dim InxA As Long
  Dim InxR As Long

  Debug.Print "=============================================="
  With ItemCrnt
    Debug.Print "  Created: " & .CreationTime
    Debug.Print " Receiver: " & .ReceivedByName
    Debug.Print " Received: " & .ReceivedTime
    For InxR = 1 To .Recipients.Count
      Debug.Print "Recipient: " & .Recipients(InxR)
    Next
    Debug.Print "   Sender: " & .Sender
    Debug.Print " SenderEA: " & .SenderEmailAddress
    Debug.Print " SenderNm: " & .SenderName
    Debug.Print "   SentOn: " & .SentOn
    Debug.Print "  Subject: " & .Subject
    Debug.Print "       To: " & .To
    If .Attachments.Count > 0 Then
      Debug.Print "Attachments:"
      For InxA = 1 To .Attachments.Count
        Debug.Print "    " & InxA & ": " & .Attachments(InxA).DisplayName
      Next
    End If
  End With

End Sub

This second macro displays selected properties of an email.

The idea behind these two macros is that you can discover the property of a MailItem that matches one of the properties of a ContactItem so you can link them. My guess is that a ContactItem’s Email1Address will match a MailItem’s SenderEmailAddress.

This is a possible calling routine:

Public Sub InvestigateEmails()

  ' Outputs all or selected properties of one or more emails.

  Dim Exp As Explorer
  Dim ItemCrnt As MailItem

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Please select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    For Each ItemCrnt In Exp.Selection
      If ItemCrnt.Class = olMail Then
        Call OutSomeProperties(ItemCrnt)
      End If
    Next
  End If

End Sub

This macro uses method 1 to select emails to be processed. That is, the user selects one or more emails and then calls this macro to process them. I find this the easiest approach to developing a new email processing macro. I can select one simple email and single step through the macro to check how it processes the email. I can then select progressively more complicated emails until the macro can process emails of any complexity to my satisfaction.

Note that signatures and images can be recorded as attachments for VBA but not for the user. You will need to recognise those attachments you want to save and those that you don’t.

Do senders reuse names? If John Smith always names his attachments something like “MyHomework.docx”, SaveAsFile will overwrite the previous homework without warning. If you do not want to overwrite the previous homework, you will have to make the filenames unique in some way.

My suggested approach is:

  • Use macro DemoContacts to investigates the properties of a ContactItem.
  • Use macro InvestigateEmails and OutSomeProperties to investigates the properties of a MailItem.
  • Identify the properties that allow you to match a contact to an email and identify the property(ies) you need to extract from the contact.
  • Start a new macro with a name like SaveStudentHomework. Do not use names like SaveAttachmentsToDisk. Today you are saving homework attachments. In a few months you may be saving a different type of attachment. What will you call that macro? If you name macros for their purpose, you are less likely to need to change those names. The declaration for the new macro should be Public Sub SaveStudentHomework (ItemCrnt As Outlook.MailItem) which will allow it to be used with a rule or as an event routine.
  • The first version of this macro should extract the properties from the email that are to be matched against the contact. Loop through the contacts and search for the matching one. Use Debug.Print to confirm success.
  • You now have the information to build the path name for SaveAsFile. Save the wanted attachments with unique names if necessary.
  • Once SaveStudentHomework is working to your satisfaction, create a rule and link the macro using “Run a script”.
0
votes

I've found a solution:

Public Sub SaveAttachmentsToDiskAll(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\Me\Dropbox\School\Academic\All students\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & MItem.SenderName & "\" & oAttachment.DisplayName
Next
End Sub