none
VB script; save Outlook 2010 attachment 2 times. RRS feed

  • Question

  • Hi all,

    I've found a script on the internet that allows me to save my Outlook 2010 attachment to a network drive and name it "Most-Recent-Forecast.jpg".Is there a way that I can ALSO save it with the original name of the attachment?

    So I want to save the attachment twice.
    Below is what I use. Thanks in advance.

    gitsie

    Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim olkFolder As Outlook.MAPIFolder, _
    olkAttachment As Outlook.Attachment, _
    objFSO As Object, _
    strRootFolderPath As String, _
    strFilename As String, _
    intCount As Integer
    'Change the following path to match your environment
    strRootFolderPath = "I:\Perm\Weather Forecasts\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set olkFolder = Application.ActiveExplorer.CurrentFolder
    If Item.Attachments.Count > 0 Then
    For Each olkAttachment In Item.Attachments
    If objFSO.GetExtensionName(LCase(olkAttachment.FileName)) = "jpg" Then
    strFilename = "Most-Recent-Forecast.jpg"
    intCount = 0
    Do While True
    If objFSO.FileExists(strRootFolderPath & strFilename) Then
    intCount = intCount + 1
    objFSO.deletefile (strRootFolderPath & strFilename)
    Else
    Exit Do
    End If
    Loop
    olkAttachment.SaveAsFile strRootFolderPath & strFilename
    End If
    Next
    End If
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkFolder = Nothing
    End Sub

    • Moved by Bill_Stewart Monday, December 2, 2013 3:41 PM Move to more appropriate forum
    Monday, December 2, 2013 12:33 PM

Answers

  • Hi Gitsie,

    I really ought to watch the details a bit more: I just noticed a spelling error (one dot too many)

    olkAttachment.SaveAsFile strRootFolderPath & olkAttachment.FileName

    (I had written "olk . Attachment.FileName", which was ... not quite right)

    May this be of more aid :)

    Cheers,
    Fred


    There's no place like 127.0.0.1

    • Marked as answer by gitsie Tuesday, December 3, 2013 4:30 PM
    Monday, December 2, 2013 3:46 PM
  • In Outlook VBA this is all you need to do to save multiple copies.  You also do not need to use FSO as all of its functionality is normally built into the objects.

    Sub SaveAttachmentsToDisk(ByVal Item As Outlook.MailItem)
    
    Const strRootFolderPath = "c:\temp\testolk\"
    Const strExtension = "jpg"
        
        On Error GoTo error_exit
    
            
        If Item.Attachments.Count > 0 Then
            
            Dim olkAttachment As Outlook.Attachment
            For Each olkAttachment In Item.Attachments
                
                If Right(olkAttachment.FileName, 3) = strExtension Then
                    olkAttachment.SaveAsFile strRootFolderPath & olkAttachment.FileName
                    olkAttachment.SaveAsFile strRootFolderPath & "Most-Recent-Forecast.jpg"
                Else
                    ' save other5 attachments
                End If
            
            Next
        
        End If
        
        Exit Sub
    
    error_exit:
        MsgBox Err.Description
        
    End Sub

    The error trap will be helpful.


    ¯\_(ツ)_/¯

    • Proposed as answer by Eugene Astafiev Monday, December 2, 2013 9:08 PM
    • Marked as answer by gitsie Tuesday, December 3, 2013 4:30 PM
    Monday, December 2, 2013 6:40 PM

All replies

  • Jo Gitsie,

    I don't have any experience with VBscript itself (and can't find a reason to still use it either), but being able to read, I think your issue is about here:

    strFilename = "Most-Recent-Forecast.jpg"

    replacing it with this line, I'd guess you'd have more luck:

    strFilename = olkAttachment.FileName

    still, this will only work for jpg files (since that's what the script filters for). Sooo ...

    If objFSO.GetExtensionName(LCase(olkAttachment.FileName)) = "jpg" Then

    might possibly work as

    If True Then

    This latter is pure guesswork and I'm confident there are a lot more efficient (and readable) ways to make this script work. I merely don't have enough of an inkling about VB to confidently do that (and not the interest to change it).

    Cheers,
    Fred


    There's no place like 127.0.0.1

    Monday, December 2, 2013 1:04 PM
  • Hi Fred,

    Thanks for your reaction.

    I was actually not looking to replace, but to add another instance of saving. I want to save the file twice.

    I tried all sorts of combinations of:

    strFilename = "Most-Recent-Forecast.jpg" AND strFilename = olkAttachment.FileName

    and

    strFilename = "Most-Recent-Forecast.jpg" & strFilename = olkAttachment.FileName

    gitsie

    Monday, December 2, 2013 1:31 PM
  • Yo,

    in that case, how about adding below

    olkAttachment.SaveAsFile strRootFolderPath & strFilename

    another line like this:

    olkAttachment.SaveAsFile strRootFolderPath & olk.Attachment.FileName

    Might that work?

    Cheers,
    Fred


    There's no place like 127.0.0.1

    Monday, December 2, 2013 2:21 PM
  • Yo,

    That did not do anything.

    gitsie

    Monday, December 2, 2013 2:51 PM
  • What you found is VBA, not VBScript. You could either post your query in a VBA forum or else use the script below. It checks your inbox for a mail item with the subject "Weekly Insights", then generates a pop-up panel with the names of all attached files.

    sSubject = "Weekly Insights"
    Const InboxFolder = 6
    Set oOutlook   = CreateObject("Outlook.Application")
    Set oNamespace = oOutlook.GetNamespace("MAPI")
    Set oInbox     = oNamespace.GetDefaultFolder(InboxFolder)
    'SaveAttachmentsToDisk(oItem)
    For Each oMail In oInbox.items    'Alle E-Mails im Posteingang untersuchen
        If oMail.Subject = sSubject Then
            For Each oAttachment In oMail.Attachments
                MsgBox "Name of the attachment: " & oAttachment.FileName
            Next
        End If
    Next

    Monday, December 2, 2013 3:19 PM
  • Hi Gitsie,

    I really ought to watch the details a bit more: I just noticed a spelling error (one dot too many)

    olkAttachment.SaveAsFile strRootFolderPath & olkAttachment.FileName

    (I had written "olk . Attachment.FileName", which was ... not quite right)

    May this be of more aid :)

    Cheers,
    Fred


    There's no place like 127.0.0.1

    • Marked as answer by gitsie Tuesday, December 3, 2013 4:30 PM
    Monday, December 2, 2013 3:46 PM
  • In Outlook VBA this is all you need to do to save multiple copies.  You also do not need to use FSO as all of its functionality is normally built into the objects.

    Sub SaveAttachmentsToDisk(ByVal Item As Outlook.MailItem)
    
    Const strRootFolderPath = "c:\temp\testolk\"
    Const strExtension = "jpg"
        
        On Error GoTo error_exit
    
            
        If Item.Attachments.Count > 0 Then
            
            Dim olkAttachment As Outlook.Attachment
            For Each olkAttachment In Item.Attachments
                
                If Right(olkAttachment.FileName, 3) = strExtension Then
                    olkAttachment.SaveAsFile strRootFolderPath & olkAttachment.FileName
                    olkAttachment.SaveAsFile strRootFolderPath & "Most-Recent-Forecast.jpg"
                Else
                    ' save other5 attachments
                End If
            
            Next
        
        End If
        
        Exit Sub
    
    error_exit:
        MsgBox Err.Description
        
    End Sub

    The error trap will be helpful.


    ¯\_(ツ)_/¯

    • Proposed as answer by Eugene Astafiev Monday, December 2, 2013 9:08 PM
    • Marked as answer by gitsie Tuesday, December 3, 2013 4:30 PM
    Monday, December 2, 2013 6:40 PM
  • Hi JRV,

    Thanks, that worked like a charm (after removing the "Byval") from the first line.

    Tuesday, December 3, 2013 4:32 PM
  • Hi Fred,

    That worked, thank you.

    gitsie

    Tuesday, December 3, 2013 4:33 PM