Extracting Outlook files.. with macro.

[vaxo]

Hello Friends, I need Outlook macro for the following purpose: Extract all attached files in a folder with the specific people.. ( If it would have date criteria would be more pleasurable) could you help me, please?

[HansV]

What do you mean by "a folder with the specific people"?

[vaxo]

In a specific location on my computer with specific people,( for example v.magrakvelidze@gmail.com).

[HansV]

So the code should create a folder for each unique sender?

And what does this have to do with Excel? Shouldn't the macro run in Outlook?

[vaxo]

The macro should run in outlook, and a need to specify in the macro for the specific sender to extract all attachments in a specific folder.

[HansV]

I have moved this thread from the Excel forum to the Outlook forum.

I'm still not clear on what you want. Do you want to process messages from one specific sender only?

[vaxo]

Yes, only for specific sender.

[HansV]

I cobbled this together from several pieces of code that I had. Please test thoroughly.
You should create a new module in the Visual Basic Editor in Outlook and paste the code into that module.

Code: Select all

Sub ExportAttachments()
    Dim oFld As Folder
    Dim sSender As String
    Dim vOut As Variant
    Dim oItm As Object
    Dim oAtt As Attachment
    Dim sName As String
    On Error Resume Next
    Set oFld = Session.PickFolder
    On Error GoTo ErrHandler
    If oFld Is Nothing Then
        MsgBox "You didn't select an email folder", vbExclamation
        Exit Sub
    End If
    sSender = InputBox("Enter the sender")
    If sSender = "" Then
        MsgBox "You didn't enter a sender!", vbExclamation
        Exit Sub
    End If
    vOut = BrowseForFolder
    If vOut = False Then
        MsgBox "You didn't select an output folder!", vbExclamation
        Exit Sub
    End If
    If Right(vOut, 1) <> "\" Then
        vOut = vOut & "\"
    End If
    For Each oItm In oFld.Items
        If oItm.SenderEmailAddress = sSender Then
            If oItm.Attachments.Count > 0 Then
                For Each oAtt In oItm.Attachments
                    sName = oAtt.FileName
                    Call CorrectName(sName)
                    sName = vOut & sName
                    oAtt.SaveAsFile sName
                Next oAtt
            End If
        End If
    Next oItm
ExitHandler:
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    'Function purpose:  To Browser for a user selected folder.
    'If the "OpenAt" path is provided, open the browser at that directory
    'NOTE:  If invalid, it will open at the Desktop level

    Dim ShellApp As Object

    'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    'Destroy the Shell Application
    Set ShellApp = Nothing

    'Check for invalid or non-entries and send to the Invalid error handler if found
    'Valid selections can begin L: (where L is a letter) or \\ (as in \\servername\sharename.
    'All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
        Case ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select

    Exit Function

Invalid:
    'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

Sub CorrectName(s As String)
    Dim varInvalids As Variant
    Dim intC As Integer
    varInvalids = Array("?", "*", "|", "<", ">", "\", ":", "/", """")
    For intC = LBound(varInvalids) To UBound(varInvalids)
        s = Replace(s, varInvalids(intC), "_")
    Next intC
End Sub

[vaxo]

It is great appliacation but in the last step: "Object doesn't support this property or method" text error? why?

[vaxo]

I need to download all attachments from a specific sender on the desktop? Does the code make this?

[HansV]

The code will prompt you to select an email folder - you can select the inbox, or another folder.
And it will also prompt you to specify the sender.
Finally, it will prompt you to specify a folder to save the attachments to - you can select your desktop.
The code could easily be modified to use fixed data instead of prompting.

About the error: temporarily change the line

On Error GoTo ErrHandler

to

On Error GoTo 0

When the error occurs, click Debug. Which line is highlighted?

[vaxo]

The message is on outlook like in picture,

[vaxo]

If oItm.SenderEmailAddress = sSender Then

[HansV]

Did you happen to select a folder that contains other types of items besides email messages?

[vaxo]

No, Main Inbox contains messages and attached files.

[vaxo]

When i change the inbox to sent items, the error is not identified but nothing happens, the folder is empty, no downloaded attached files (documents, excel files....)

[HansV]

I'm sorry, but I don't know why it doesn't work for you. I tested the code successfully in my Outlook...

[vaxo]

Maybe something a small problem is or there another way to execute these? Please this is very importent for my job...

[HansV]

Since the code works for me, I cannot offer specific help.
Have you tried single-stepping through the code?

[vaxo]

"Have you tried single-stepping through the code?" could you give me a little explanation and I would try..

Also in the sender bar I enter full mail address is this right?