Consulting

Results 1 to 20 of 20

Thread: Auto saving files and renaming file name. Genius needed.

  1. #1
    VBAX Newbie
    Joined
    Jun 2010
    Location
    Gatineau
    Posts
    5
    Location

    Auto saving files and renaming file name. Genius needed.

    Hello everyone.

    Let me start by saying, please be gentle, I知 not a programmer but I知 a tech. Programming is not my area of expertise.

    That being said, my users were using Eudora as a mail client. Eudora has an option to automatically save mail attachments to a distant folder. In our case the attachments are saved to a network folder. We are replacing Eudora with Outlook but unfortunately Outlook does not offer this option. I found multiple scripts on the web but most was just too complicated for my needs so I managed to simplify one and make it work. Here is the script:

    [VBA]
    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

    Dim objAtt As Outlook.Attachment

    Dim saveFolder As String
    saveFolder = "c:\temp\"

    For Each objAtt In itm.Attachments
    objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
    Set objAtt = Nothing
    Next
    End Sub
    [/VBA]
    Now the issue I have is that if I receive multiple emails with attachments that have the same name, witch is often the case here, the latest attachment will overwrite the older attachment without warning. What I知 trying to do in the script bellow is to rename the attachments when they come in by adding a decimal at the end of the file name. Unfortunately my script bellow does not work. It runs in a loop non stop and I have no clue what I知 doing thus no clue how to fix this or what is missing.

    [VBA]
    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

    On Error Resume Next

    Dim objAtt As Outlook.Attachment

    Dim saveFolder As String
    Dim stFileName As String
    Dim i As Integer

    saveFolder = "c:\temp"

    For Each objAtt In itm.Attachments
    stFileName = saveFolder & "\" & objAtt.DisplayName
    i = 0
    While FileLen(stFileName) > 0
    If Err <> 0 Then Err = 0
    i = i + 1
    stFileName = saveFolder & "\" & Str(i) & objAtt.DisplayName
    MsgBox stFileName
    Wend
    If Err <> 0 Then Err = 0
    objAtt.SaveAsFile stFileName
    Set objAtt = Nothing
    Next
    End Sub
    [/VBA]
    Is there a genius out here that can help me with this? PLEASE!!!!

    Thanks a bundle.
    Mike

  2. #2
    VBAX Regular
    Joined
    Sep 2005
    Posts
    35
    Location
    Why reinventing the wheel?
    Did you already try this, too?
    http://code.google.com/p/lightlook/

    Each message has its own folder created containing its attachments, which can be easily opened by clicking in the message itself.

  3. #3
    VBAX Newbie
    Joined
    Jun 2010
    Location
    Gatineau
    Posts
    5
    Location
    Creating a folder for every email received is overkill for the users. They receive hundreds of emails per day. That makes for hundreds of additional double clicking and deleting folder that file renaming upon reception would prevent.

    There is surely someone in here that can make this work. Anyone?

    TY
    Mike

  4. #4
    VBAX Newbie
    Joined
    Jun 2010
    Posts
    1
    Location
    Hi

    I use the following variation of the same script in Outlook 2003 to insert the date and time stamp before the file extension (not very elegant but it works)

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "c:\a"

    For Each objAtt In itm.Attachments
    posr = InStrRev(objAtt.FileName, ".")
    ext = Right(objAtt.FileName, Len(objAtt.FileName) - posr)
    posl = InStr(objAtt.FileName, ".")
    fname = Left(objAtt.FileName, posr - 1)
    objAtt.SaveAsFile saveFolder & "\" & fname & "_" & Format(itm.ReceivedTime, "ddmmyyyy_hhmm") & "." & ext
    Set objAtt = Nothing
    Next
    End Sub

  5. #5
    VBAX Regular
    Joined
    Sep 2005
    Posts
    35
    Location
    Quote Originally Posted by Putt4Dough
    Creating a folder for every email received is overkill for the users.
    Why? they don't do anything, they just select the messages with attachments and they press a button. All the work is done by the macro: creating folders named like message subject followed by date+time, saving attachments into those folders, removing attachments from messages, inserting into messages links to saved attachments.

  6. #6
    VBAX Newbie
    Joined
    Jun 2010
    Location
    Gatineau
    Posts
    5
    Location
    Quote Originally Posted by inxain
    Hi

    I use the following variation of the same script in Outlook 2003 to insert the date and time stamp before the file extension (not very elegant but it works)

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "c:\a"

    For Each objAtt In itm.Attachments
    posr = InStrRev(objAtt.FileName, ".")
    ext = Right(objAtt.FileName, Len(objAtt.FileName) - posr)
    posl = InStr(objAtt.FileName, ".")
    fname = Left(objAtt.FileName, posr - 1)
    objAtt.SaveAsFile saveFolder & "\" & fname & "_" & Format(itm.ReceivedTime, "ddmmyyyy_hhmm") & "." & ext
    Set objAtt = Nothing
    Next
    End Sub
    This script works but for us it痴 more work. The clients send us a huge amount of emails per day. All these attachments have long file names. Adding the date and time to every file gives them more work since when the attachment is translated it need to be returned to the client with the original file name. With this script, the user needs to delete the added date and time. All this is additional work.

    What I need is to rename an attachment only if a file with the same name already exists in the folder. Let say I have a file 殿utosave.doc in my C:\attachment\ folder and I receive a new email with a file named autosave.doc. I would like the script to check if a file with that name already exists, if so, rename it autosave1.doc.

    I知 sure that this is possible but I知 not a programmer and have no clue on how configure it.

    TY
    Mike

  7. #7
    This should work I guess:

    saveFolder = "C:\attachment"
    For Each objAtt In itm.Attachments
    stFileName = saveFolder & "\" & objAtt.DisplayName
    i = 0
    JumpHere:
    If Dir(stFileName) = "" then
    objAtt.SaveAsFile stFileName
    else
    i=i+1
    stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
    goto Jumphere
    end if
    Set objAtt = Nothing
    Next

    Reg
    Sagnik

  8. #8
    VBAX Newbie
    Joined
    Jun 2010
    Location
    Gatineau
    Posts
    5
    Location
    Perfect. That is exactly what I was looking for. Tried and tested and it works perfectly. Thanks a bunch.

  9. #9
    VBAX Newbie
    Joined
    Jun 2010
    Location
    Gatineau
    Posts
    5
    Location
    Look at the en for the code I use now. Change the saveFolder = path to your needs.

    In Outlook press on Alt-F11. On the left pane click on Project1, Microsoft office outlook, ThisOutllokSession then paste the code in the right pane. Save and the click on Debug, Compile project1. Close MS VB.

    You will then need to create a rule in Outlook to run the script for incoming mail. Tools, Rules and Alerts, New rules, Start from a blank rule, Check message when they arrive, Through a specific account, run a script, next and finish.

    [VBA]
    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "k:\download"
    For Each objAtt In itm.Attachments
    stFileName = saveFolder & "\" & objAtt.DisplayName
    i = 0
    JumpHere:
    If Dir(stFileName) = "" Then
    objAtt.SaveAsFile stFileName
    Else
    i = i + 1
    stFileName = saveFolder & "\" & i & " - " & objAtt.DisplayName
    GoTo JumpHere
    End If
    Set objAtt = Nothing
    Next

    End Sub
    [/VBA]

  10. #10
    VBAX Newbie
    Joined
    Dec 2012
    Posts
    3
    Location

    Post Main email with Sub emails attached, contains the file to be extracted


    Hi,

    Thank you for this code. This worked perfect for me except...the emailsbeing sent to me contain multiple sub-email attachments (items) with the .csvfiles I need! In other words, I have one email that contains multiple email attachments(see att), and each of those email attachments contains the file I need. Is itpossible to extract those files to a folder? I don't need the emails, just thefiles (they happen to be .csv files each one named the same thing so I thinkthe current code will handle renaming them to a sequential file name).


    Please don't yell at me , I did not ask for this set up but that's the way I'm getting it sent to me! Please help if you can.
    Attached Images Attached Images

  11. #11
    VBAX Newbie
    Joined
    Dec 2012
    Posts
    3
    Location
    .....to illustrate further here is an example of one of the sub emails opened up. Each .csv file is named "Invoice".
    Attached Images Attached Images

  12. #12
    VBAX Newbie
    Joined
    Dec 2012
    Posts
    1
    Location

    SOLVED: saving and renaming multiple attachments per email

    Last edited by BobRPC; 12-31-2012 at 06:29 PM.

  13. #13
    VBAX Mentor
    Joined
    Feb 2009
    Posts
    493
    Location
    This is what works for me. I've been using it for years. Just pass the mail object and the folder path you want to save the attachments to the sub and it will save all the attachments for you and if there are multiples of the same name it will add a file number like windows does when it makes copies. IE filename(1).csv

    [VBA]Sub downloadmail(myMailItem, strPath As String)
    Dim strFileName As String
    Dim strNewName As String
    Dim strPre As String
    Dim strExt As String
    Dim myolAttachments As Attachments
    Dim myolAtt As Attachment
    Dim intExtlen As Integer
    Dim w As Integer
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    If myMailItem.Attachments.Count <> 0 Then
    Set myolAttachments = myMailItem.Attachments
    For Each myolAtt In myolAttachments
    strFileName = myolAtt.DisplayName
    'find out if the file exists in the download location already and if so rename
    'to a filename including a number eg. file(1).xls
    If fs.fileexists(strPath & "\" & strFileName) = True Then
    strNewName = strFileName
    'get the length of the extension including the .
    intExtlen = Len(strFileName) - InStrRev(strFileName, ".") + 1
    'check there is actually a file extension and if not set extension to blank
    'and set strPre to the full file name
    If InStrRev(strFileName, ".") > 0 Then
    strExt = Right(strFileName, intExtlen)
    strPre = Left(strFileName, Len(strFileName) - intExtlen)
    Else
    strExt = ""
    strPre = strFileName
    End If
    'increase the file number (w) until the file name no longer exists file(1).ext to file(2).ext etc
    'strpre = filename before extension strext = extension w=file number
    While fs.fileexists(strPath & "\" & strNewName) = True
    w = w + 1
    strNewName = strPre & Chr(40) & w & Chr(41) & strExt
    Wend
    'set the new filename
    strFileName = strNewName
    w = 0
    End If
    myolAtt.SaveAsFile strPath & "\" & strFileName
    AttachmentCount = AttachmentCount + 1
    Set myolAtt = Nothing
    Next
    End If
    myMailItem.UnRead = False
    End Sub[/VBA]
    -----------------------------------------
    The more you learn about something the more you know you have much to learn.

  14. #14
    VBAX Newbie
    Joined
    Dec 2012
    Posts
    3
    Location
    Thank you!

  15. #15
    Quote Originally Posted by BrianMH
    This is what works for me. I've been using it for years. Just pass the mail object and the folder path you want to save the attachments to the sub and it will save all the attachments for you and if there are multiples of the same name it will add a file number like windows does when it makes copies. IE filename(1).csv
    I was wondering if I could get some assistance with your code.

    I have successfully used this code:

    [VBA]
    Public Sub SaveAttachments()
    'Note, this assumes you are in the a folder with e-mail messages when you run it.
    'It does not have to be the inbox, simply any folder with e-mail messages

    Dim App As New Outlook.Application
    Dim Exp As Outlook.Explorer
    Dim Sel As Outlook.Selection

    Dim AttachmentCnt As Integer
    Dim AttTotal As Integer
    Dim MsgTotal As Integer

    Set Exp = App.ActiveExplorer
    Set Sel = Exp.Selection

    'Loop thru each selected item in the inbox
    For cnt = 1 To Sel.Count
    'If the e-mail has attachments...
    If Sel.Item(cnt).Attachments.Count > 0 Then
    MsgTotal = MsgTotal + 1
    AttTotal = AttTotal + Sel.Item(cnt).Attachments.Count
    'For each attachment on the message...
    For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count
    'Get the attachment
    Dim att As Attachment
    Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
    'Save it to disk
    att.SaveAsFile ("H:\Attachments\" + att.FileName)
    Next
    End If
    Next

    'Clean up
    Set Sel = Nothing
    Set Exp = Nothing
    Set App = Nothing

    'Let user know we are done
    Dim doneMsg As String
    doneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments in " + Format$(MsgTotal, "#,0") + " Messages."
    MsgBox doneMsg, vbOKOnly, "Save Attachments"

    Exit Sub

    ErrorHandler:

    Dim errMsg As String
    errMsg = "An error has occurred. Error " + Err.Number + " " + Err.Description
    Dim errResult As VbMsgBoxResult
    errResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save Attachments")
    Select Case errResult
    Case vbAbort
    Exit Sub

    Case vbRetry
    Resume

    Case vbIgnore
    Resume Next

    End Select

    End Sub


    [/VBA]


    But I would like to integrate the code that adjusts for files of the same name (by adding a number at the end of the file). Where in my code do I insert the code you posted above?

    Thank you for the help.

  16. #16
    Does anyone know how to change the attachment name to match that of the email's subject?

  17. #17
    Looking to do a couple of things here:
    1. I have multiple attachments coming in per email, how can i edit my code to pick up attachments? (code below)

    ElseIf (UCase(Msg.Subject) = "SAMPLE") Then
    attPath = "PATH ON HD"
    Set myAttachments = oItem.Attachments
    Att = myAttachments.item(1).DisplayName
    myAttachments.item(1).SaveAsFile attPath & Att

    2. Is it possible to entirely rename all attachments coming in regardless of their current name? (names of attachments will change daily)

  18. #18
    2. Is it possible to entirely rename all attachments coming in regardless of their current name? (names of attachments will change daily)
    yes just change the name for the destination file

    for each att in oitem.attachments
       att.saveasfile "path\filename.ext" 
    next
    of course you need to have some dynamic destination filename, else you would only end up keeping the last attachment, as each would overwrite the previous, it may be simpler to save each attachment with it's displayname, then rename as required after saving

  19. #19
    Sorry i dont understand. Can you give me an example

  20. #20
    Sorry i dont understand.
    what is it that you do not understand?
    i would have though the example i posted, based on the amount of information you provided, would have been enough to get you started

Posting Permissions

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