[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 200
  • Last Modified:

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

0
gdunn59
Asked:
gdunn59
  • 5
  • 4
1 Solution
 
Chris BottomleyCommented:
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
 
gdunn59Author Commented:
Chris,

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

Thanks,
gdunn59
0
 
Chris BottomleyCommented:
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
Microsoft Certification Exam 74-409

VeeamĀ® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

 
gdunn59Author Commented:
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
 
Chris BottomleyCommented:
OK ... may be the morning till I pick it back up though.

Chris
0
 
gdunn59Author Commented:
Ok.  Thanks!
0
 
gdunn59Author Commented:
There was a problem with the macro security settings and the email security Digital ID.
0
 
gdunn59Author Commented:
Thank you very much for your assistance.

gdunn59
0
 
Chris BottomleyCommented:
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

Restore individual SQL databases with ease

Veeam Explorer for Microsoft SQL Server delivers an easy-to-use, wizard-driven interface for restoring your databases from a backup. No expert SQL background required. Web interface provides a complete view of all available SQL databases to simplify the recovery of lost database

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now