Visual Basic Macro for Outlook

[jdarville]

Good Morning,

The code below will look for at incoming emails and create a folder in desired location for each attachment automatically. It names the folders whatever the attached file is but i actually need it to label the folders with the name of the sender.

Example, if i get an email with an attachment from joeshoem@thecompany.com i want the script to create a folder called thecompany and save the attached file in that folder. That's the ultimate gold but i can settle with joeshoem@thecompany.com as the folder name as well.

Sub SaveAttachments_VariableFolder(MyMail As MailItem)

Dim Atmt As attachment

Dim FileName As String
Dim lenName As Long
Dim strPathAdd As String

Const strPath As String = "C:\test\" ' set as desired

On Error Resume Next
MkDir strPath
On Error GoTo 0

For Each Atmt In MyMail.Attachments

    If (Right(Atmt, Len(Atmt) - InStrRev(Atmt, "."))) = "pdf" Then
    
        lenName = InStrRev(Atmt, ".") - 1
            
        ' Trim possible spaces before the extension.
        ' A space at the end of the name created a problem with deleting the folder
        strPathAdd = strPath & Trim(Left(Atmt, lenName)) & "\"
            
        On Error Resume Next
        MkDir strPathAdd
        On Error GoTo 0

        FileName = strPathAdd & Atmt.FileName
        Atmt.SaveAsFile FileName
        
    End If
    
Next Atmt

Set Atmt = Nothing
    
End Sub