Solved

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

Posted on 2011-03-08
9
187 Views
Last Modified: 2012-05-11
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

0
Comment
Question by:gdunn59
  • 5
  • 4
9 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 250 total points
ID: 35071913
Try the following:

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 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
        Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkMessage = Nothing
End Sub

Open in new window

0
 

Author Comment

by:gdunn59
ID: 35072024
Chris,

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

Thanks,
gdunn59
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35072532
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

0
 

Author Comment

by:gdunn59
ID: 35072637
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
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35073033
OK ... may be the morning till I pick it back up though.

Chris
0
 

Author Comment

by:gdunn59
ID: 35073648
Ok.  Thanks!
0
 

Author Comment

by:gdunn59
ID: 35125765
There was a problem with the macro security settings and the email security Digital ID.
0
 

Author Closing Comment

by:gdunn59
ID: 35125768
Thank you very much for your assistance.

gdunn59
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35125798
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
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

This article will show you how to use shortcut menus in the Access run-time environment.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

743 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

15 Experts available now in Live!

Get 1:1 Help Now