asked on

Have emails with both PDF and TXT files attached - need to just pull the TXT files and Save to Network Folder

I have emails that I receive that have both PDF and TXT files attached. I need to just pull the TXT file attachments from the email and save to a folder on the network.

I have the following code (see attached code), but it is pulling both the PDF and TXT files, and as mentioned above I just want to save the TXT attachments.

What do I need to change/add in my existing code to do this?

Thanks,

gdunn59

Sub SaveOutlookAttachments(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Path for where to save attachments
    strRootFolderPath = "X:\sh_fox\FIR_TBT\2011\2011_ExceptionReports\2011_March\3-7-2011\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.Count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            strFilename = olkAttachment.FileName
            intCount = 0
            Do While True
                If objFSO.FileExists(strRootFolderPath & strFilename) Then
                    intCount = intCount + 1
                    strFilename = "Copy (" & intCount & ") of " & olkAttachment.FileName
                Else
                    Exit Do
                End If
            Loop
            olkAttachment.SaveAsFile strRootFolderPath & strFilename
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

gdunn59

ASKER

Chris,

I tried your code, but nothing happens at all. It doesn't even run.

Thanks,
gdunn59

Chris Bottomley

Since the change is trivial perhaps one of the attachments filename is shorter than 4 chars.

Chris

Sub SaveOutlookAttachments(olkMessage As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment, _
        objFSO As Object, _
        strRootFolderPath As String, _
        strFilename As String
    'Path for where to save attachments
    strRootFolderPath = "X:\sh_fox\FIR_TBT\2011\2011_ExceptionReports\2011_March\3-7-2011\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkSourceFolder = Application.ActiveExplorer.CurrentFolder
    If olkMessage.Attachments.count > 0 Then
        For Each olkAttachment In olkMessage.Attachments
            strFilename = olkAttachment.filename
            if len(strfilename) > 4 then 
                If LCase(Right(strFilename, 4)) = ".txt" Then
                    intCount = 0
                    Do While True
                        If objFSO.FileExists(strRootFolderPath & strFilename) Then
                            intCount = intCount + 1
                            strFilename = "Copy (" & intCount & ") of " & olkAttachment.filename
                        Else
                            Exit Do
                        End If
                    Loop
                    olkAttachment.SaveAsFile strRootFolderPath & strFilename
                end if
            End If
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

gdunn59

ASKER

Sorry, I think it may be something with the Rule that I'm using. But it was working fine until I pasted in the new code.

I have to jump on something else right now, and will try to get back to it this afternoon.

I will keep you posted as to the status.

Thanks,
gdunn59

Chris Bottomley

OK ... may be the morning till I pick it back up though.

Chris

gdunn59

ASKER

Ok. Thanks!

gdunn59

ASKER

There was a problem with the macro security settings and the email security Digital ID.

gdunn59

ASKER

Thank you very much for your assistance.

gdunn59

Chris Bottomley

I used to have issues with secured messages and found the only solution was to skip them. But it makes for dirty code so not something I routinely add ... and difficult to test now as I use a Mac so no VBA!

Chris