Opening Outlook Attachment in Excel

[acp1]

I'd like to have an Outlook macro that

a) using the email that's currently open (or selected)
b) select the attachment (a txt file)
c) save it to a local folder (ie. c:\temp)
d) open that txt file in excel

Any help would be appreciated

AC

 

[acp1]

Alright... I've been looking things up and playing around with this for a few hours and have come up with a partial solution.

What i'd prefer, however, is to be able to browse through Outlook and select any email that has a TXT file attachment and then click on the macro button to run the script for only the selected email..... is that possible?

Sub testST()

' This Outlook macro checks a named subfolder in the Outlook Inbox
' (here the "STARS Reports" folder) for messages with attached
' files of a specific type (here file with an "txt" extension)
' and saves it to disk. Saved file is timestamped. The user
' can choose to view the saved files in Windows Explorer.

' NOTE: make sure the specified subfolder and save folder exist

' before running the macro.
    On Error GoTo SaveAttachmentsToFolder_err

' Declare variables
    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 varResponse As VbMsgBoxResult
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = ns.Folders("Backup").Folders("STARS Reports")
    Dim i As Integer
    i = 0
    
' Check each message for attachments
    For Each Item In SubFolder.Items
        For Each Atmt In Item.Attachments

' Check filename of each attachment and save if it has "txt" extension
            If Right(Atmt.FileName, 3) = "TXT" Then
            ' This path must exist! Change folder name as necessary.
                FileName = "C:\" & _
                    Format(Item.CreationTime, "yyyymmdd_") & Atmt.FileName
                Atmt.SaveAsFile FileName
                i = i + 1
            End If
        Next Atmt
    Next Item

' Show summary message
    If i > 0 Then
        varResponse = MsgBox("Would you like to view the files now?" _
        , vbQuestion + vbYesNo, "Finished!")
' Open Windows Explorer to display saved files if user chooses
        If varResponse = vbYes Then
            Shell "C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE " & FileName
        End If
    Else
        MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
    
' Clear memory
SaveAttachmentsToFolder_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub

' Handle Errors
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

 

[acp1]

Alright! I seem to have solved this... I can now select an e-mail in Outlook, click on the macro and it opens in Excel.

What i'd now like to do is do some "clean-up" in excel now.

The problem is that the file that opens up in excel has a lot of formatting issues so i'd like to 2 things:

1) for every cell in excel spreadsheet, run the "TRIM()" function to clean up spaces before and after all the text

2) for some reason, a lot of the numbers in this spreadsheet are treated as text and i've found (by trial and error) that the best way to "fix" this is to do a find/replace 0 to 0, 1 to 1, 2 to 2 etc... I'm sure there's probably an easier way to do this (and i'd welcome it) but this has worked for me so far

I'd really appreciate some guidance

Sub STARS()

    On Error GoTo Handle_err

    Dim objFolder As Outlook.MAPIFolder
    Dim objNS As Outlook.NameSpace
    Dim objItem As Outlook.MailItem
    Dim objAtmt As Attachment
    Dim FileName As String
    Dim varResponse As VbMsgBoxResult
    Dim i As Integer
    i = 0

    ' Check if there is any item selected
    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    End If
    
    ' Goes through selected items
    For Each objItem In Application.ActiveExplorer.Selection
            
                For Each objAtmt In objItem.Attachments
                    ' Check filename of each attachment and save if it has "txt" extension
                    If Right(objAtmt.FileName, 3) = "TXT" Then
                        ' This path must exist! Change folder name as necessary.
                        FileName = "C:\temp\" & Format(objItem.CreationTime, "yyyymmdd_") & objAtmt.FileName
                        objAtmt.SaveAsFile FileName
                        i = i + 1
                    End If
                Next objAtmt
                                
                ' Show summary message
                If i > 0 Then
                    varResponse = MsgBox("Would you like to view the files now?" _
                        , vbQuestion + vbYesNo, "Finished!")
                        
                ' Open Windows Explorer to display saved files if user chooses
                If varResponse = vbYes Then
                    Shell "C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE " & FileName
                End If
                Else
                    MsgBox "No attached files in your e-mail.", vbInformation, "Finished!"
                End If
                 
    Next
 
ClearMem_exit:
    Set objItem = Nothing
    Set objFolder = Nothing
    Set objNS = Nothing
    Set objAtmt = Nothing
    Exit Sub

Handle_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: STARS Attachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume ClearMem_exit

End Sub