Consulting

Results 1 to 19 of 19

Thread: Pulling Specified Attachments: VBA

  1. #1

    Pulling Specified Attachments: VBA

    Currently, I have the following code and rule set up working, which automatically pulls attachments from incoming emails and saves them to a shared drive in Outlook 2010. This also is pulling in signatures, etc, of which I do not need. I solely need ".pdf" files to be extracted from emails and saved to the shared folder. I know I am missing a simple line of code in order to accomplish this, but after several attempts, I think I may keep finding the right "IF" statement, but I can't seem to figure out what it is or where to put it.

    Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    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

    For Each Item In Inbox.Items
    For Each Atmt In Item.Attachments
    FileName = "\\Invoices for Processing" & _
    Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    Next Atmt
    Next Item


    End Sub

    Any help would be greatly appreciated. Thanks.

  2. #2
    UPDATE:
    I was able to get the specific file time to be the only file pulled, but now I need to know how to get a different email inbox to be the one that it pulls from, IE: it is currently pulling everything from thejesterAT..... and I need it to pull from APInvoicesAT.....

    Forum wouldn't let me post updated VBA ???

  3. #3
    Figured out it doesn't like "AT" signs.

    Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim myExt As String

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0

    For Each Item In Inbox.Items
    For Each Atmt In Item.Attachments
    myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
    Select Case myExt
    Case ".pdf"
    FileName = "\\AP Invoices for Processing" & _
    Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    Case Else
    End Select
    Next Atmt
    Next Item


    End Sub

  4. #4
    If you are running this code on messages as they arrive using a rule, why are you then looking at all the items in inbox? It is the item that arrives that is of interest. So assuming that your file path is correct the following is all you require.

    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
        For Each Atmt In Item.Attachments
            myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
            Select Case myExt
                Case ".pdf"
                    FileName = "\\AP Invoices for Processing" & _
                               Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
                    Atmt.SaveAsFile FileName
                Case Else
            End Select
        Next Atmt
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Because I'm a noob, this worked perfectly, thank you very much.
    The best part of the work out? The End

  6. #6
    One issue that I see remains though, this client is using Outlook 2010. If they go home at night, IE: close out of outlook, when it is reopened, the new emails are there, but it isn't detaching the .pdf's into the shared drive. This is only happening if outlook is running. Is there a correction or just the way it is?
    The best part of the work out? The End

  7. #7
    testing on and off with my Outlook 2016, and it works either on or once turned on, I'm wondering if her 2010 may be the issue. Thoughts?
    The best part of the work out? The End

  8. #8
    OR, can you do the exact same code you have above, but for Outlook 2010? Not sure if these clients have the licenses to upgrade this Outlook 2010 to 2016.
    I tested the script on my Outlook 2016 and it worked flawlessly, with or without Outlook open.
    I apologize for the multiple posts, my thoughts have been on other issues today. Thanks in advance.
    The best part of the work out? The End

  9. #9
    Outlook 2010 and 2016 are operationally similar with regard to processing VBA code, however as the code is run in Outlook, Outlook needs to be running for the code to work in either version. There may be security implications ion which case see
    http://www.gmayor.com/create_and_emp...gital_cert.htm
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  10. #10
    The code is working in both, though the 2010 seems to work for a few and then stop, so the certificate option may be the way to go, however, the 2016 version on my PC of course doesn't run the script when it is not open, but once Outlook is opened, the script runs and all the new emails do as they are told. I created the certificate on her 2010 PC, but I couldn't see where to go view the certificate from the steps you gave to test :/ and then got lost.
    The client is going to be getting a new PC, so this may be a moot point, as everything on her current PC will be getting updated/upgraded.
    Thanks for the help. I'm sure I will have more VBA Outlook questions at a later date.
    The best part of the work out? The End

  11. #11
    If there's a security issue the macro won't run at all next time Outlook is opened, so the fact that it does suggests this is not the issue.
    Sometimes For Each ... Next loops don't behave well so try

    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
    Dim lngIndex As Long
        For lngIndex = 1 To Item.Attachments.Count
            Set Atmt = Item.Attachments(lngIndex)
            myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
            Select Case myExt
                Case ".pdf"
                    FileName = "\\AP Invoices for Processing" & _
                               Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
                    Atmt.SaveAsFile FileName
                Case Else
            End Select
        Next lngIndex
    lbl_Exit:
        Set Atmt = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  12. #12
    Ok, well, a bit of a step in the wrong direction. I have a new PC for the client, I have installed the 2016 office, with Outlook 2016, and now the VB code doesn't work at all. I believe it is running, but it doesn't pull the attachment off the email and save it to the location.
    The best part of the work out? The End

  13. #13
    Almost certainly the problem is with your path and filename

    FileName = "\\AP Invoices for Processing" & _
                               Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
    Use the correct full path here such as
    FileName = "C:\Path\AP Invoices for Processing\" & _
                               Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  14. #14
    I thought the same thing, but have since deleted the email account and the rule to start from scratch. Reinstalled the email account and recreated the rule as the last script written above. NOW, the rule ONLY runs with I use the "Run Rule Now" button.
    ???

    USING
    [vba]
    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
    For Each Atmt In Item.Attachments
    myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
    Select Case myExt
    Case ".pdf"
    FileName = "...\AP Invoices for Processing" & _
    Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
    Atmt.SaveAsFile FileName
    Case Else
    End Select
    Next Atmt
    End Sub
    [/vba]
    The best part of the work out? The End

  15. #15
    I've double checked that I don't have an errant "." or space any place, but without using the actual server, the patch is a mapped drive to:
    \\1.1.1.1\Attachments\AP Invoices for Processing\

    it was working great on my pc, but I can not get it to initiate on hers. She now has Office 2016 (Outlook), I've enabled the "unsafe" "run a script" tab in the registry. I know there is a password to get to the mapped location, would that suddenly make a difference? It didn't before. Yes, I'm making sure the drive is mapped and is connected when trying to run the script. No ideas what would keep it from running at this point or why it was running on my desktop, then stopped.
    The best part of the work out? The End

  16. #16
    [SOLVED]
    Thank you sweet (insert appropriate religious figure to your belief system here)!!!!
    Finally figured this out. In the Macro Security tab, which I hadn't seen due to the developer tab wasn't activated, "Notifications for digitally signed macros, all other macros disabled" was CHECKED. I simply changed that to "Enable all macros....." and it went, like a dream.
    Thank you for all your patience and advice. I'm exhausted
    [SOLVED]
    The best part of the work out? The End

  17. #17

    new mystery, same code

    The above was solved....fast forward a year or so to now, and I'm trying to move this over to a new user account. I'm getting this:
    invalid.JPG

    What am I doing wrong?
    The best part of the work out? The End

  18. #18
    There should be a line break between
        Next lngIndex
    lbl_Exit:
    as shown in the original code.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  19. #19
    Quote Originally Posted by gmayor View Post
    If there's a security issue the macro won't run at all next time Outlook is opened, so the fact that it does suggests this is not the issue.
    Sometimes For Each ... Next loops don't behave well so try

    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
    Dim lngIndex As Long
        For lngIndex = 1 To Item.Attachments.Count
            Set Atmt = Item.Attachments(lngIndex)
            myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
            Select Case myExt
                Case ".pdf"
                    FileName = "\\AP Invoices for Processing" & _
                               Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
                    Atmt.SaveAsFile FileName
                Case Else
            End Select
        Next lngIndex
    lbl_Exit:
        Set Atmt = Nothing
        Exit Sub
    End Sub
    Hi I seem to get an error for the section I have highlighted red?

    Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •