Solved

save first attachment

Posted on 2004-04-04
6
335 Views
Last Modified: 2010-04-08
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
Comment
Question by:chspit
  • 3
  • 3
6 Comments
 

Author Comment

by:chspit
Comment Utility
Can anyone help me out with this? Thanks.
0
 
LVL 1

Expert Comment

by:vhpcomp
Comment Utility
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
 
LVL 1

Accepted Solution

by:
vhpcomp earned 500 total points
Comment Utility
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
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

 

Author Comment

by:chspit
Comment Utility
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
 

Author Comment

by:chspit
Comment Utility
Ok, just figured it out myself. Thanks.
0
 
LVL 1

Expert Comment

by:vhpcomp
Comment Utility
Thanks for the points chspit :-)
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Set OWA language and time zone in Exchange for individuals, all users or per database.
Use these top 10 tips to master the art of email signature design. Create an email signature design that will easily wow recipients, promote your brand and highlight your professionalism.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now