Solved

save first attachment

Posted on 2004-04-04
6
338 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
ID: 10773880
Can anyone help me out with this? Thanks.
0
 
LVL 1

Expert Comment

by:vhpcomp
ID: 10775835
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
ID: 10776156
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
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 

Author Comment

by:chspit
ID: 10779022
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
ID: 10779156
Ok, just figured it out myself. Thanks.
0
 
LVL 1

Expert Comment

by:vhpcomp
ID: 10779867
Thanks for the points chspit :-)
0

Featured Post

Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

What does UTC stand for?  “Coordinated Universal Time” – Think of this as the true time on Planet Earth that never changes with the exception of minor leap seconds here and there to account for the changes in the planet's rotation.   What does th…
Read this checklist to learn more about the 15 things you should never include in an email signature.
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

773 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