Outlook question

DrJimmy

Registered User.
Local time
Today, 08:45
Joined
Jan 10, 2008
Messages
49
Hi,

Not strictly an access question but hoping someone with VBA skills can help out. I've hundreds of emails, from the same person, all with attachments. Is there a VBA script I can run that will look at these emails and download the attachment to a specified area on my drive - without me having to do it one by one?

Cheers
 
You could write one. Go to OUTLOOK, not ACCESS, to see the discussion of VBA and objects available from an outlook application. Not sure that you have an easy way to do this directly from Outlook, though it DOES support VBA. OK, let's say you have some sort of record-keeping you want to do. So let's keep that in Access for the purposes of this discussion. In that case, ...

Once you have an idea of what it all looks like, you need to study Access help on how to manipulate application objects. You would need to understand collections and how to enumerate them, traverse them, step through them, or whatever other name you might choose for the process. 'cause with lots of mail files, you'll have a collection of mail objects somewhere.

Then you could open Outlook as an application object, step into your inbox, enumerate your mails, look at the Sender data or Subject data, and where you find the ones you want, start stepping through the message file to verify it is the right message (if there is some text key you needed to see), and manipulate the attachments.

You can open the file system object as a way to locate the place where you want to put the files. You would have the OUTLOOK object do the saving for you, not Access, because the OUTLOOK attachment collection should have a Save method (or SaveAs method) that you could apply to the attachments.

This is an overview. You need to study Access Help and Outlook help, collection navigation, the File System Object, and Applications Objects. Sounds formidable? Not as bad as all that, just takes some getting used to it.
 
Open Outlook, go to Tools and Macro and Visual Basic Editor and paste in this code. This will save the attachment to a folder called Email Attachments. It does it for the selected emails. So you would sort your Inbox on the column From and that will group the emails you need. Click on the first email and press the Shift key and then click the last email in the group and then run the macro.

The attachments will be saved to the folder with the following name format

Date and time of email_ email address name of sender Subject was Whatever original file name

If there was no subject it will put No Subject and if it was a forwarded email the subject will have the FW: removed.

The file in the folder will look like:

2009-07-21_00-08-36_ JohnSmith@optusnet.com.au John Smith Subject was The file you requested Letter

Letter is the original name of the file.

The code is messy because I have just got it working. If you want it to go to a different folder then just change where is says Email Attachments.

If you are not use to VBA some of the lines will be Green and they have a ' in front of them, which is like deleting the line. But there are some lines that are not relevant but I have not commented them out.

It has only been tested in MS Office 2003 and on XP Pro.

It will bring up the Outlook security box. Just click in the white box and then they will all run through.

Code:
Public Sub SaveAttachments()
 
Dim objOL As Outlook.Application
Dim objMsg As MailItem
Dim objAttachments As Attachments
Dim objSelection As Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim FileName As String
 
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    On Error Resume Next
 
    Set objOL = CreateObject("Outlook.Application")
 
    Set objSelection = objOL.ActiveExplorer.Selection
 
    strFolderpath = strFolderpath & "\xyz\"
 
    For Each objMsg In objSelection
 
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
 
 
 
 
    If lngCount > 0 Then
 
 
 
    For i = lngCount To 1 Step -1
 
 
 
    strFile = objAttachments.Item(i).FileName
 
 
 
 
    'strFile = strFolderpath & strFile
 
    If objMsg.Subject = Empty Then
objMsg.Subject = "No Subject"
End If
objMsg.Subject = LTrim(Right(objMsg.Subject, Len(objMsg.Subject) - InStr(objMsg.Subject, ":")))
 
    strFile = "c:\Email Attachments\" + Format(objMsg.CreationTime, "YYYY-MM-DD" + " " & "hh-mm-ss") + " " & (objMsg.SenderEmailAddress) + " " & (objMsg.SenderName) + " " & "Subject was" + " " & (objMsg.Subject) & " " & strFile
 
    '("c:\StoreLettersDemo\" + Format(myOlMail.CreationTime, "YYYY-MM-DD" + " " & "hh-mm-ss") + " " & (myOlMail.SenderEmailAddress) + " " & (myOlMail.SenderName) + " " & "Subject was" + " " & (myOlMail.Subject) + ".doc")
 
 
    objAttachments.Item(i).SaveAsFile strFile
 
 
 
 
    'objAttachments.Item(i).Delete
 
 
    If objMsg.BodyFormat <> olFormatHTML Then
        strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
        Else
        strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
        strFile & "'>" & strFile & "</a>"
    End If
 
 
 
    Next i
    End If
 
 
    If objMsg.BodyFormat <> olFormatHTML Then
        objMsg.Body = objMsg.Body & vbCrLf & _
        "The file(s) were saved to " & strDeletedFiles
    Else
        objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
        "The file(s) were saved to " & strDeletedFiles & "</p>"
    End If
        objMsg.Save
 
    Next
 
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
 
Last edited:

Users who are viewing this thread

Back
Top Bottom