Save and Rename Attachment

[ebrown00]

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?

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 tags courtesy of www.thecodenet.com

[Crocus Crow]

Replace:

FileName = "\\AD\MyND_RO\Profile\HomeDrive\LDP DSS\TV DISPLAY\" & Atmt.FileName 

VBA tags courtesy of www.thecodenet.com

with:

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 tags courtesy of www.thecodenet.com

[ebrown00]

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?

[Crocus Crow]

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):

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 tags courtesy of www.thecodenet.com

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.

[ebrown00]

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