Excel Hints

Results 1 to 5 of 5

Thread: Save and Rename Attachment

  1. #1

    Lightbulb Save and Rename Attachment

    Hello,

    Using VBA in Outlook, I am trying to save attachments from a handful of daily emails and rename the files using the SAME name each day, essentially replacing the set of files each day. I have the code to save the attachments, but I'm stumped when it comes to renaming the files. The email subject lines and the files have the date in them, and I would like to save the files without the date (Example, if the email subject line reads "Weekly Dashboard 3/25/12 - 3/31/12", the file is "Weekly Dashboard 3/25/12 - 3/31/12.xlsx". I need the file to be renamed "Weekly Dashboard.xlsx".

    Here is the code I have so far (I also attached it for easier viewing). Can someone help me out?

    [vba]Sub GetAttachments()
    On Error GoTo SaveAttachmentsToFolder_err
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim varResponse As VbMsgBoxResult
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders("Reports")
    Dim objAtt As Outlook.Attachment
    If SubFolder.Items.Count = 0 Then
    MsgBox "There are no messages in the Reports folder.", vbInformation, _
    "Nothing Found"
    Exit Sub
    End If
    For Each Item In SubFolder.Items
    For Each Atmt In Item.Attachments
    If Right(Atmt.FileName, 4) = "xlsx" Then
    FileName = "\\AD\MyND_RO\Profile\HomeDrive\LDP DSS\TV DISPLAY\" & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    End If
    Next Atmt
    Next Item
    If i > 0 Then
    varResponse = MsgBox("I found " & i & " attached files." _
    & vbCrLf & "I have saved them into \\AD\MyND_RO\Profile\HomeDrive\LDP DSS\TV DISPLAY." _
    & vbCrLf & vbCrLf & "Would you like to view the files now?" _
    , vbQuestion + vbYesNo, "Finished!")
    If varResponse = vbYes Then
    Shell "Explorer.exe /e,\\AD\MyND_RO\Profile\HomeDrive\LDP DSS\TV DISPLAY\", vbNormalFocus
    End If
    Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
    SaveAttachmentsToFolder_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
    SaveAttachmentsToFolder_err:
    MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume SaveAttachmentsToFolder_exit
    End Sub[/vba]
    Attached Files Attached Files
      To view attachments your post count must be 0 or greater. Your post count is 0 momentarily.

  2. #2
    Replace:
    [vba]FileName = "\\AD\MyND_RO\Profile\HomeDrive\LDP DSS\TV DISPLAY\" & Atmt.FileName
    [/vba]with:
    [vba] Dim p As Integer
    p = InStr(Atmt.fileName, "/")
    p = InStrRev(Atmt.fileName, " ", p)
    fileName = "\\AD\MyND_RO\Profile\HomeDrive\LDP DSS\TV DISPLAY\" & Left(Atmt.fileName, p - 1) & ".xlsx"
    [/vba]

  3. #3
    I replaced the code and got this error message:

    "An unexpected error has occurred.
    Please note and report the following information.
    Macro Name: GetAttachments
    Error Number: 5
    Error Description: Invalid procedure call or argument"

    Is this because some of the files have a date and some do not?

  4. #4
    Quote Originally Posted by ebrown00
    Is this because some of the files have a date and some do not?
    Yes, probably, though it's difficult to know for certain without seeing the actual file name with which it fails.

    Try this instead (entirely replaces my previous code):
    [vba] Dim p As Integer
    fileName = Atmt.fileName
    p = InStr(fileName, "/")
    If p > 0 Then
    p = InStrRev(fileName, " ", p)
    If p > 0 Then
    fileName = Left(fileName, p - 1) & ".xlsx"
    End If
    End If
    fileName = "\\AD\MyND_RO\Profile\HomeDrive\LDP DSS\TV DISPLAY\" & fileName
    [/vba]The code is just a simple string parser based on your described file name format - look at the functions used in the VB help to understand how it works.

    If it still doesn't work, set a breakpoint on a suitable line and debug it in the VB editor.

  5. #5
    Thanks for the help! It didn't quite work, so I'll try to debug it.

Posting Permissions

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