• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 349
  • Last Modified:

save first attachment

Hi,

How can I save an attachment of the first mail item that has an attachment in the Inbox folder in Outlook 2002 by using VBA?

If there are other mail with attachment I want to leave them. I only want to save the attachment of the first mail item in the list that has an attachment. I also have mail without attachment, which I want to leave it there.

Example:

Mail_A     name_A
Mail_B     name_B + attachment1
Mail_C     name_C
Mail_D     name_D + attachment2

So in this case I only want to save attachment 1 (of Mail_B) and delete Mail_B from the list, then close outlook.
How can I do this?

Thanks
0
chspit
Asked:
chspit
  • 3
  • 3
1 Solution
 
chspitAuthor Commented:
Can anyone help me out with this? Thanks.
0
 
vhpcompCommented:
Hi Chspit,

Can you clarify when you say "first" email with attachment, how are you sorting, oldest, alpha by subject, etc.  I've succesfully looped through and saved attachments but I've always looked for something specific in the subject line and/or attachment name, etc so I'll need to experiment with sorting before the loop begins, if that is your requirement.

Also,  in the example above, would it be possible for Mail_B to have more than one attachment?  I assume in that case you would just want to save the first one.
0
 
vhpcompCommented:
Chspit,
This should work (connects to inbox)

Sub SaveAttachment()

Dim oOL As Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
Dim m As Outlook.MailItem
Dim objItems As Object
Dim myAttach As Object
Dim sSubject As String
Dim i As Integer, iCount As Integer
Dim sPath, sFileName As String


On Error GoTo ERROR_HANDLER


Application.DisplayAlerts = False

'name of path and file name for saving attachment
sPath = "c:\MyTestFolder\"
sFileName = "MyAttachedFile.xls"

'get a reference to Outlook folder
Set oOL = CreateObject("Outlook.Application")
Set oNS = oOL.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
 
 'get count of items in folder
   Set objItems = oFolder.Items
    iCount = objItems.Count
   
 'this loops through and looks for the first attachment
 For i = iCount To 1 Step -1
    If TypeName(objItems(i)) = "MailItem" Then
        Set m = objItems(i)
        If m.Attachments.Count > 0 Then
                Set myAttach = m.Attachments(1)
                myAttach.SaveAsFile sPath & sFileName
                m.Delete
                Exit For
        End If
    End If
Next i
                                 
                                   
   
                                         
EXIT_SAVEATTACHMENT:

    'clean up objects
    Set myAttach = Nothing
    Set m = Nothing
    Set oFolder = Nothing
    Set oNS = Nothing
    Set oOL = Nothing
    Application.DisplayAlerts = True
    Exit Sub

ERROR_HANDLER:

Resume EXIT_SAVEATTACHMENT
                             

End Sub
0
Veeam Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

 
chspitAuthor Commented:
Hi vhpcomp,

First of all thanks for your help. Your code works fine on its own. However I have a slight problem. I had already written some code to check if the file extension is 'jpg' otherwise the image would not be saved. Now if i try to intgrate your code with mine I can't make the macro run. So can you please show me how I can integrate the two codes?

This is my code:

<<<<<<<<<<<<<<<<<<<<<<<<<
' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
   
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
   
' Check each message for attachments
    For Each Item In Inbox.Items    
        For Each Atmt In Item.Attachments
       
' Check filename of each attachment and save if it has "jpg" extension
            If Right(Atmt.FileName, 3) = "jpg" Then
           
            FileName = "C:\attachments\" & Atmt.FileName
                               
                Atmt.SaveAsFile FileName
                Item.Delete
                   
             Else: Item.Delete
             
            End If
                       
        Next Atmt
       
    Next Item

' Clear memory
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
   
End Sub
>>>>>>>>>>>>>>>>>>>>

So basically I want to add a line to your code that also checks for the attachment extension. I tried, but a run-time error occurred, saying that an Object variable or a With block is not set. Can you please show me how to do it cause I think I am missing something. Thanks.
0
 
chspitAuthor Commented:
Ok, just figured it out myself. Thanks.
0
 
vhpcompCommented:
Thanks for the points chspit :-)
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now