Outlook Email Attachment Macro 1

[DrMingle]

I can't get this to run without running into errors...any help would be appreciated....

Sub GetAttachments()
' This Outlook macro checks a the Outlook Inbox for messages
' with attached files (of any type) and saves them to disk.
' NOTE: make sure the specified save folder exists before
' running the macro.
    On Error GoTo GetAttachments_err
' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
' Check Inbox for messages and exit of none found
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox.", vbInformation, _
               "Nothing Found"
        Exit Sub
    End If
' Check each message for attachments
    For Each Item In Inbox.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
            FileName = "\\papi-srv-clus4\clus4-profiles\TNFR\users\wts\drmingle\Desktop\Email Attachment." & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item
' Show summary message
    If i > 0 Then
        MsgBox "I found " & i & " attached files." _
        & vbCrLf & "I have saved them into the C:\Email Attachments folder." _
        & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
    Else
        MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
' Clear memory
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle errors
GetAttachments_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume GetAttachments_exit
End Sub

 

[PHV]

running into errors
Which error messages on which lines of code ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DrMingle]

Outlook cannot do this action on this type of attachment."
error code: -867155963

I can't tell which line of code I'm getting the issue on...because of the error box.

 

[PHV]

No Debug button in the error box ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DrMingle]

I took the MsgBox code out so I could get a debug setup...

Here is what I have...as the problem...

FileName = "\\papi-srv-clus4\clus4-profiles\TNFR\users\wts\drmingle\Desktop\Email Attachment." & Atmt.FileName

 

[PHV]

What about using Atmt.DisplayName instead ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DrMingle]

Interesting...

Well that solved the error issue...

...but the msgbox stated it found 83 attachments, but 45 is what came through and there was no error message this time...
...any ideas?

 

[PHV]

You probably have attachments with same name.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DrMingle]

Your exactly right.

Any idea how to check multiple folders under the inbox?
My folder tree is setup (exactly):
Inbox
Auditors/Net Mgmt
Auditor Questions
Donna Hall

Are spaces, "/", and "**" symbols going to give me trouble in the below code?

Would it look something like this...

' Check Inbox.Suggestion for messages and exit of none found
    If Inbox.Auditors/Net Mgmt.Auditor Questions.Donna Hall.Items.Count = 0 Then
        MsgBox "There are no messages in the Inbox.", vbInformation, _
               "Nothing Found"
        Exit Sub
    End If
' Check each message for attachments
    For Each Item In Inbox.Auditors/Net Mgmt.Auditor Questions.Donna Hall.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
            FileName = "\\papi-srv-clus4\clus4-profiles\TNFR\users\wts\drmingle\Desktop\EmailAttachment." & Atmt.DisplayName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item

 

[PHV]

I'd use the Folders property of the MAPIFolder object.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DrMingle]

Is the below what I am trying to move towards...if I need to access my "non-default" folders in Outlook?

I have not worked at all wtih MAPIF
objects before...

Outlook._Application olApp = new Outlook.ApplicationClass();
Outlook._NameSpace olNS = olApp.GetNamespace("MAPI");Outlook._Folders oFolders;
oFolders = olNS.Folders;
Outlook.MAPIFolder oPublicFolder = oFolders.Item("Public Folders");
oFolders = oPublicFolder.Folders;
Outlook.MAPIFolder oAllPFolder = oFolders.Item("All Public Folders");
oFolders = oAllPFolder.Folders;
Outlook.MAPIFolder oMyFolder  = oFolders.Item("My Public Folder");
Console.Write(oMyFolder.Name);