Announcement

Collapse
No announcement yet.

VBA: Convert excel attachment from .xlsm to .xlsx and re-send

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • VBA: Convert excel attachment from .xlsm to .xlsx and re-send



    Hi there,

    I have a macro which can convert (from .xlsm to .xlsx) and re-send an excel file from within Microsoft Excel, however need to be able to use this as a Microsoft Outlook rule for emails received. How would I adapt my code to achieve this? I know how to attach the code to a rule and have the rule work on incoming email, just can't seem to adapt the code to work in Outlook:

    Code:
    Option ExplicitSub Mail_workbook_Outlook_2()
    
    
    ' This macro will run in Excel 2007 and 2010.
    ' It will send the Active File in an Outlook e-mail as an attachment.
    ' If the active file is .xls or .xlsm, it could contain macros, so
    ' the file is saved as .xlsx and then e-mailed.
    ' If the file is .xlsx, no copy is made, the file is just sent.
    ' This macro is designed to only send .xls, .xlsx or .xlsm files.
    ' In all cases the file is sent as .xlsx.
    '
        Dim wb1 As Workbook, wb2 As Workbook
        Dim TempFilePath As String, TempFileName As String
        Dim OutApp As Object, OutMail As Object
        Set wb1 = ActiveWorkbook
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        If Val(Application.Version) >= 12 Then 'Check for Office 2007+
            If wb1.FileFormat = xlOpenXMLWorkbookMacroEnabled Then '52, .xlsm
                MsgBox "This will open an email window for you to submit your order.", _
                    vbInformation, "e-mailing Active File"
                
                 'Make a copy of the file/Open it/Mail it/Delete it
                 'If you want to change the file name then change only TempFileName
                TempFilePath = Environ$("temp") & "\"
                TempFileName = "Copy of " & wb1.Name
                TempFileName = Left(TempFileName, Len(TempFileName) - 1) 'remove the trailing "m"
                
                wb1.SaveCopyAs TempFilePath & TempFileName & "m" 'Format cannot be changed during savecopy
                 'Open the copy, save as .xlsx to remove macros, then close it
                Set wb2 = Workbooks.Open(TempFilePath & TempFileName & "m")
                Application.DisplayAlerts = False
                wb2.SaveAs TempFilePath & TempFileName & "x", 51 '51=.xlsx
                wb2.Close
                Application.DisplayAlerts = True
            
            ElseIf wb1.FileFormat = xlExcel8 Then '56, .xls (97-2003) which could contain macros
                MsgBox "This is a .xls file which could contain macros." & vbCr & _
                    "It will be saved as .xlsx before sending.", _
                    vbInformation, "e-mailing Active File"
                    
                 'Make a copy of the file/Open it/Save as .xlsx/Close it/Mail it/Delete it
                 'If you want to change the file name then change only TempFileName
                TempFilePath = Environ$("temp") & "\"
                TempFileName = "Copy of " & wb1.Name
                
                wb1.SaveCopyAs TempFilePath & TempFileName 'Format cannot be changed during savecopy
                 'Open the copy, save as .xlsx to remove macros, then close it
                Set wb2 = Workbooks.Open(TempFilePath & TempFileName)
                Application.DisplayAlerts = False
                wb2.SaveAs TempFilePath & TempFileName & "x", 51 '51=.xlsx
                wb2.Close
                Application.DisplayAlerts = True
                
            ElseIf wb1.FileFormat = xlOpenXMLWorkbook Then '51, .xlsx
                 'The ActiveWorkbook is a .xlsx file which cannot contain
                 'macros so no need to make copies before attaching...
                 'Since it can't contain macros, it can't contain THIS mcaro!
                
                wb1.Save   'Uncomment to save before sending #####################
                TempFilePath = wb1.Path & "\"
                TempFileName = wb1.Name
                TempFileName = Left(TempFileName, Len(TempFileName) - 1)
            
            Else
                End Sub
            End If
    
                    
             'Set up outlook
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
        
             'Create message
            On Error Resume Next
            With OutMail
                .to = "[email protected]"
                .CC = ""
                .BCC = ""
                .Subject = "New Order"
                .Body = " "
                .Attachments.Add TempFilePath & TempFileName & "x"
                '.Display   'Use only during debugging ##############################
                .Send      'Uncomment to send e-mail ##############################
            End With
        
             'Delete any temp files created
            Kill TempFilePath & TempFileName & "x"
            Kill TempFilePath & TempFileName & "m"
            Kill TempFilePath & TempFileName
            On Error GoTo 0
        
            Set OutMail = Nothing
            Set OutApp = Nothing
        Else
            MsgBox "This macro has not been coded to work in pre-2007 versions of office.", _
                vbExclamation, "e-mailing Active File"
        End If
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End Sub
    Any help would be appreciated, thanks very much.

    ***Please note that the above code is not my own and has been adapted from code found on the internet. I take no credit for the above VBA code.

  • #2
    Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

    It's a finicky re-write, not complicated but lots of little details to modify.

    First stage - Change any objects declared as an Excel object to generic objects, and change the generic Outlook objects to 'real' Outlook objects...

    Code:
    Dim wb1 As Object
    Dim OutApp As Outlook.Application
    2nd - Replace any intrinsic Excel Constants with their actual value
    Code:
    wb1.FileFormat = 51   '// xlOpenXMLWorkbook  (.xlsx)
    3rd - Declare a generic object for Excel and Start it
    Code:
    Dim oXL as Object
    Set oXL = CreateObject("Excel.Application")
    You then need to save any attachments in the current email message, load them in Excel and do the SaveAs/Load/Save procedure.

    Might suggest you start with the first 3 points and see if you can get that working first.

    Also, there seems to be a logic error there. You check
    Code:
    If Val(Application.Version) >= 12 Then 'Check for Office 2007+
    but if that check fails, the code continues to create an email and attach a non-existant file...

    I might also suggest the running this off the Inbox might not be a good idea (at least, I'm assuming that's where the rule runs...). It would be more sensible to have a rule that moves incoming mails to a separate folder and this code is then run against that folder.

    EDIT - Didn't take that long, 20 minutes or so.
    Last edited by cytop; September 4th, 2013, 20:43. Reason: Comment.

    Comment


    • #3
      Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

      Thank you very much for your help so far cytop, i'm new to VisualBasic outside of Excel and to be truthful, not heavily experienced in VisualBasic full stop.

      That being said, I've now made the amendments as detailed in stages 1, 2 and 3 below:

      Code:
      Option Explicit
      Sub Mail_workbook_Outlook_2()  
       
       ' This macro will run in Excel 2007 and 2010.
       ' It will send the Active File in an Outlook e-mail as an attachment.
       ' If the active file is .xls or .xlsm, it could contain macros, so
       ' the file is saved as .xlsx and then e-mailed.
       ' If the file is .xlsx, no copy is made, the file is just sent.
       ' This macro is designed to only send .xls, .xlsx or .xlsm files.
       ' In all cases the file is sent as .xlsx.
       '
      Dim wb1 As Object, wb2 As Object
      Dim oXL As Object
      Dim TempFilePath As String, TempFileName As String 
      Dim OutApp As Outlook.Application, OutMail As Outlook.Application 
      Set oXL = CreateObject("Excel.Application") 
      Set wb1 = ActiveWorkbook 
       
      Application.ScreenUpdating = False 
      Application.EnableEvents = False 
       
      If Val(Application.Version) >= 12 Then 'Check for Office 2007+
          If wb1.FileFormat = 52 Then 'xlOpenXMLWorkbookMacroEnabled (.xlsm)
              MsgBox "This will open an email window for you to submit your order.", _ 
              vbInformation, "e-mailing Active File" 
               
               'Make a copy of the file/Open it/Mail it/Delete it
               'If you want to change the file name then change only TempFileName
              TempFilePath = Environ$("temp") & "\" 
              TempFileName = "Copy of " & wb1.Name 
              TempFileName = Left(TempFileName, Len(TempFileName) - 1) 'remove the trailing "m"
               
              wb1.SaveCopyAs TempFilePath & TempFileName & "m" 'Format cannot be changed during savecopy
               'Open the copy, save as .xlsx to remove macros, then close it
              Set wb2 = Workbooks.Open(TempFilePath & TempFileName & "m") 
              Application.DisplayAlerts = False 
              wb2.SaveAs TempFilePath & TempFileName & "x", 51 '.xlsx
              wb2.Close 
              Application.DisplayAlerts = True 
               
          ElseIf wb1.FileFormat = 56 Then 'xlExcel8, .xls (97-2003) which could contain macros
              MsgBox "This is a .xls file which could contain macros." & vbCr & _ 
              "It will be saved as .xlsx before sending.", _ 
              vbInformation, "e-mailing Active File" 
               
               'Make a copy of the file/Open it/Save as .xlsx/Close it/Mail it/Delete it
               'If you want to change the file name then change only TempFileName
              TempFilePath = Environ$("temp") & "\" 
              TempFileName = "Copy of " & wb1.Name 
               
              wb1.SaveCopyAs TempFilePath & TempFileName 'Format cannot be changed during savecopy
               'Open the copy, save as .xlsx to remove macros, then close it
              Set wb2 = Workbooks.Open(TempFilePath & TempFileName) 
              Application.DisplayAlerts = False 
              wb2.SaveAs TempFilePath & TempFileName & "x", 51 '.xlsx
              wb2.Close 
              Application.DisplayAlerts = True 
               
          ElseIf wb1.FileFormat = 51 Then 'xlOpenXMLWorkbook, .xlsx
               'The ActiveWorkbook is a .xlsx file which cannot contain
               'macros so no need to make copies before attaching...
               'Since it can't contain macros, it can't contain THIS mcaro!
               
              wb1.Save 'Uncomment to save before sending #####################
              TempFilePath = wb1.Path & "\" 
              TempFileName = wb1.Name 
              TempFileName = Left(TempFileName, Len(TempFileName) - 1) 
               
          Else 
          End Sub 
      End If 
       
       
       'Set up outlook
      Set OutApp = CreateObject("Outlook.Application") 
      Set OutMail = OutApp.CreateItem(0) 
       
       'Create message
      On Error Resume Next 
      With OutMail 
          .to = "[email protected]" 
          .CC = "" 
          .BCC = "" 
          .Subject = "New Order" 
          .Body = " " 
          .Attachments.Add TempFilePath & TempFileName & "x" 
           '.Display   'Use only during debugging ##############################
          .Send 'Uncomment to send e-mail ##############################
      End With 
       
       'Delete any temp files created
      Kill TempFilePath & TempFileName & "x" 
      Kill TempFilePath & TempFileName & "m" 
      Kill TempFilePath & TempFileName 
      On Error Goto 0 
       
      Set OutMail = Nothing 
      Set OutApp = Nothing 
      Else 
          MsgBox "This macro has not been coded to work in pre-2007 versions of office.", _ 
          vbExclamation, "e-mailing Active File" 
      End If 
      Application.ScreenUpdating = True 
      Application.EnableEvents = True 
      End Sub
      And now believe I am ready to look at saving attachments from the current message, and then load/save as/send them as the correct format. Would you have any pointers for how to achieve this? I assume that the code would be a modification of the current routine which creates a temporary file, as it would only need to attach the temp file to a new email?

      As for the version check, thanks for noticing that - although I know for a fact that the version used will be Microsoft Office 2007, so I'm happy to ignore.

      Comment


      • #4
        Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

        not heavily experienced in VisualBasic
        Perhaps this will be more useful then...
        Code:
        Sub Mail_workbook_Outlook_2()
        
            ' This macro will run in Excel 2007 and 2010.
            ' It will send the Active File in an Outlook e-mail as an attachment.
            ' If the active file is .xls or .xlsm, it could contain macros, so
            ' the file is saved as .xlsx and then e-mailed.
            ' If the file is .xlsx, no copy is made, the file is just sent.
            ' This macro is designed to only send .xls, .xlsx or .xlsm files.
            ' In all cases the file is sent as .xlsx.
            '
            Dim oWB As Object
            Dim oXL As Object
        
            Dim TempFilePath As String
            Dim TempFileName As String
            
            '// A general counter...
            Dim lngMsgIndex As Long
            
            '// Main Outlook objects
            Dim OlApp As Outlook.Application
            Dim olThisMail As Outlook.MailItem
            Dim olNewMail As Outlook.MailItem
            
            '// Other Outlook objects
            '// The current OutLook message list
            Dim OlExp As Outlook.Explorer
            '// Selected (Highlighted) messages
            Dim OlSel As Outlook.Selection
            '// A Single mail message
            Dim oMail As Outlook.MailItem
            
            '// this is more for a shortcut than anything else
            Set OlApp = Outlook.Application
            
             '// refer to OutLook Explorer
            Set OlExp = Application.ActiveExplorer
             
             '// And get a reference to selected items
            Set OlSel = OlExp.Selection
            
            '// Start Excel...
            Set oXL = CreateObject("Excel.Application")
            
            If Val(oXL.Application.Version) < 12 Then
                oXL.Application.Quit
                Set oXL = Nothing
                MsgBox "This procedure can only run in Excel 2007 or newer...", vbExclamation, "Error"
                Exit Sub
            End If
            
            TempFilePath = Environ$("temp") & "\"
            
             '// For each selected item in the Explorer bar
            For lngMsgIndex = 1 To OlSel.Count
                 
                 '// Only interested in Mail items. Can be easily extended to include
                 '// Appointemnts, Calendar items etc.
                If OlSel.Item(lngMsgIndex).Class = OlObjectClass.OlMail Then
            
                     '// Set a reference to this mail item
                    Set olThisMail = OlSel.Item(lngMsgIndex)
            
                    '// Assuming (for simplicity) there is only one attachment...
                    If olThisMail.Attachments.Count = 1 Then
                        
                        '// Is this an Excel file...?
                        If InStr(olThisMail.Attachments.Item(1).fileName, ".xls") > 0 Then
                            
                            TempFileName = TempFilePath & olThisMail.Attachments.Item(1).fileName
                            
                            '// Just in case - delete any existing
                            If Dir(TempFileName) <> vbNullString Then
                                Kill TempFileName
                            End If
                            
                            '// And save.
                            olThisMail.Attachments.Item(1).SaveAsFile TempFileName
                                                
                                '// Open the saved attachment in Excel...
                            Set oWB = oXL.WorkBooks.Open(fileName:=TempFileName, AddtoMRU:=False)
                            
                            Select Case oWB.FileFormat
                                
                                Case 52 '// .xlsm - ALSO NEED A CHECK FOR .XLSB
                                    TempFileName = Left$(TempFileName, Len(TempFileName) - 1) & "x"
                                    oWB.SaveAs TempFileName, 51    '51=.xlsx
                                
                                Case 56  '//  .xls (97-2003)
                                    TempFileName = TempFileName & "X"
                                    oWB.SaveAs TempFileName, 51    '51=.xlsx
                                
                                Case Else
                                    MsgBox "Logic error - unexpected file type.", vbExclamation, "Error"
                                    Err.Raise 30001, "Mail_WorkBook", "Logic error - Unexpected file type"
                            End Select
                            
                            With oWB
                                .Saved = True
                                .Close
                            End With
                            
                            Set olNewMail = OlApp.CreateItem(olMailItem)
                            
                            With olNewMail
                                .To = "[email protected]"
                                .CC = ""
                                .BCC = ""
                                .Subject = "New Order"
                                .Body = " "
                                .Attachments.Add TempFileName
                                .Display   'Use only during debugging ##############################
                                '.Send    'Uncomment to send e-mail ##############################
                            End With
                            
                        End If
                        
                    End If
            
                End If
            Next
        '
        '    Set wb1 = ActiveWorkbook
        '
        '    If Val(Application.Version) >= 12 Then    'Check for Office 2007+
        '        If wb1.FileFormat = xlOpenXMLWorkbookMacroEnabled Then    '52, .xlsm
        '            MsgBox "This will open an email window for you to submit your order.", _
        '                   vbInformation, "e-mailing Active File"
        '
        '            'Make a copy of the file/Open it/Mail it/Delete it
        '            'If you want to change the file name then change only TempFileName
        '            TempFilePath = Environ$("temp") & "\"
        '            TempFileName = "Copy of " & wb1.Name
        '            TempFileName = Left(TempFileName, Len(TempFileName) - 1)    'remove the trailing "m"
        '
        '            wb1.SaveCopyAs TempFilePath & TempFileName & "m"    'Format cannot be changed during savecopy
        '            'Open the copy, save as .xlsx to remove macros, then close it
        '            Set wb2 = Workbooks.Open(TempFilePath & TempFileName & "m")
        '            Application.DisplayAlerts = False
        '            wb2.SaveAs TempFilePath & TempFileName & "x", 51    '51=.xlsx
        '            wb2.Close
        '            Application.DisplayAlerts = True
        '
        '        ElseIf wb1.FileFormat = xlExcel8 Then    '56, .xls (97-2003) which could contain macros
        '            MsgBox "This is a .xls file which could contain macros." & vbCr & _
        '                   "It will be saved as .xlsx before sending.", _
        '                   vbInformation, "e-mailing Active File"
        '
        '            'Make a copy of the file/Open it/Save as .xlsx/Close it/Mail it/Delete it
        '            'If you want to change the file name then change only TempFileName
        '            TempFilePath = Environ$("temp") & "\"
        '            TempFileName = "Copy of " & wb1.Name
        '
        '            wb1.SaveCopyAs TempFilePath & TempFileName    'Format cannot be changed during savecopy
        '            'Open the copy, save as .xlsx to remove macros, then close it
        '            Set wb2 = Workbooks.Open(TempFilePath & TempFileName)
        '            Application.DisplayAlerts = False
        '            wb2.SaveAs TempFilePath & TempFileName & "x", 51    '51=.xlsx
        '            wb2.Close
        '            Application.DisplayAlerts = True
        '
        '        ElseIf wb1.FileFormat = xlOpenXMLWorkbook Then    '51, .xlsx
        '            'The ActiveWorkbook is a .xlsx file which cannot contain
        '            'macros so no need to make copies before attaching...
        '            'Since it can't contain macros, it can't contain THIS mcaro!
        '
        '            wb1.Save    'Uncomment to save before sending #####################
        '            TempFilePath = wb1.Path & "\"
        '            TempFileName = wb1.Name
        '            TempFileName = Left(TempFileName, Len(TempFileName) - 1)
        '
        '        Else
        '        End Sub
        '    End If
        '
        '
        '    'Set up outlook
        '    Set OutApp = CreateObject("Outlook.Application")
        '    Set OutMail = OutApp.CreateItem(0)
        '
        '    'Create message
        '    On Error Resume Next
        '    With OutMail
        '        .To = "[email protected]"
        '        .CC = ""
        '        .BCC = ""
        '        .Subject = "New Order"
        '        .Body = " "
        '        .Attachments.Add TempFilePath & TempFileName & "x"
        '        '.Display   'Use only during debugging ##############################
        '        .Send    'Uncomment to send e-mail ##############################
        '    End With
        '
        '    'Delete any temp files created
        '    Kill TempFilePath & TempFileName & "x"
        '    Kill TempFilePath & TempFileName & "m"
        '    Kill TempFilePath & TempFileName
        '    On Error GoTo 0
        '
        '    Set OutMail = Nothing
        '    Set OutApp = Nothing
        'Else
        '    MsgBox "This macro has not been coded to work in pre-2007 versions of office.", _
        '           vbExclamation, "e-mailing Active File"
        'End If
        'Application.ScreenUpdating = True
        'Application.EnableEvents = True
        
        oXL.Application.Quit
        Set oXL = Nothing
        
        End Sub
        It is essentially untested so you can debug as the learning experience rather than trying to re-write it. You'll need to read this first, though.

        The code should be copied to the ThisOutLookSession code module (Something else to learn) and you should bear iin mind that adding code to Outlook will cuase the 'Enable Macros' prompt to be displayed when Outlook is started.

        Comment


        • #5
          Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

          Thanks again cytop! After debugging, my only issues are:

          a) the code is performed on any excel attachment rather than just .xlsm (FileFormat = 52). This therefore creates an infinite loop where the macro will then run for the newly created .xlsx file and so on. Also, files which do not contain macros, or are in an accepted file format are attempted to be converted. I have tried to create a loop which ends the Sub if the attachment is in this File Format:

          Code:
          '// End the sub if the file is not a .xlsm file.
          If olThisMail.Attachments.Item(1).FileFormat <> 52 Then 'xlOpenXMLWorkbookMacroEnabled
                Exit Sub
          End If
          And for some reason, I just can't get this to work.. I know it's to do with my misunderstanding of the variables or syntax, but don't have any reference material to hand.

          b) When converting the file, a message box appears prompting the user that VB Projects will be lost when saving as .xlsx. In my initial macro, this was bypassed by using the following commands:

          Code:
          Application.DisplayAlerts = False
          .
          .
          .
          Application.DisplayAlerts = True
          But this doesn't work with the Outlook VBA.

          I really can't thank you enough for your help so far.

          Comment


          • #6
            Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

            Caught (b) already....
            Code:
                                        '// Prevent warning dialogues...
                                        oXL.DisplayAlerts = False
                                        oWB.SaveAs TempFileName, 51    '51=.xlsx
                                        oXL.DisplayAlerts = True
            Will have a look at your other issue a little later.

            Comment


            • #7
              Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

              Originally posted by cytop View Post
              Caught (b) already....
              Code:
                                          '// Prevent warning dialogues...
                                          oXL.DisplayAlerts = False
                                          oWB.SaveAs TempFileName, 51    '51=.xlsx
                                          oXL.DisplayAlerts = True
              Will have a look at your other issue a little later.
              Many thanks!

              Comment


              • #8
                Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                Try replace the procedure Mail_workbook_Outlook_2 with
                Code:
                Sub Mail_workbook_Outlook_2()
                
                    ' This macro will run in Excel 2007 and 2010.
                    ' It will send the Active File in an Outlook e-mail as an attachment.
                    ' If the active file is .xls or .xlsm, it could contain macros, so
                    ' the file is saved as .xlsx and then e-mailed.
                    ' If the file is .xlsx, no copy is made, the file is just sent.
                    ' This macro is designed to only send .xls, .xlsx or .xlsm files.
                    ' In all cases the file is sent as .xlsx.
                    '
                    Dim oWB As Object
                    Dim oXL As Object
                
                    Dim TempFilePath As String
                    Dim TempFileName As String
                
                    Dim strExtractName As String
                    Dim strNewName As String
                
                    '// A general counter...
                    Dim lngMsgIndex As Long
                
                    '// Main Outlook objects
                    Dim OlApp As Outlook.Application
                    Dim olThisMail As Outlook.MailItem
                    Dim olNewMail As Outlook.MailItem
                
                    '// Other Outlook objects
                    '// The current OutLook message list
                    Dim OlExp As Outlook.Explorer
                    '// Selected (Highlighted) messages
                    Dim OlSel As Outlook.Selection
                    '// A Single mail message
                    Dim oMail As Outlook.MailItem
                
                    '// this is more for a shortcut than anything else
                    Set OlApp = Outlook.Application
                
                    '// refer to OutLook Explorer
                    Set OlExp = Application.ActiveExplorer
                
                    '// And get a reference to selected items
                    Set OlSel = OlExp.Selection
                
                    '// Start Excel...
                    Set oXL = CreateObject("Excel.Application")
                
                    If Val(oXL.Application.Version) < 12 Then
                        oXL.Application.Quit
                        Set oXL = Nothing
                        MsgBox "This procedure can only run in Excel 2007 or newer...", vbExclamation, "Error"
                        Exit Sub
                    End If
                
                    TempFilePath = Environ$("temp") & "\"
                
                    '// For each selected item in the Explorer bar
                    For lngMsgIndex = 1 To OlSel.Count
                
                        '// Only interested in Mail items. Can be easily extended to include
                        '// Appointemnts, Calendar items etc.
                        If OlSel.Item(lngMsgIndex).Class = OlObjectClass.OlMail Then
                
                            '// Set a reference to this mail item
                            Set olThisMail = OlSel.Item(lngMsgIndex)
                
                            '// Assuming (for simplicity) there is only one attachment...
                            If olThisMail.Attachments.Count = 1 Then
                
                                '// Is this an Excel file...?
                                If InStr(olThisMail.Attachments.Item(1).fileName, ".xls") > 0 Then
                
                                    '/ Save it to the temporary directory
                                    TempFileName = TempFilePath & olThisMail.Attachments.Item(1).fileName
                
                                    '// Store the extracted file name
                                    strExtractName = TempFileName
                
                                    '// Just in case - delete any existing
                                    If Dir(TempFileName) <> vbNullString Then
                                        Kill TempFileName
                                    End If
                
                                    '// And save.
                                    olThisMail.Attachments.Item(1).SaveAsFile TempFileName
                
                                    '// Open the saved attachment in Excel...
                                    Set oWB = oXL.WorkBooks.Open(fileName:=TempFileName, AddToMRU:=False)
                
                                    '// Prevent warning dialogues...
                                    oXL.DisplayAlerts = False
                
                                    Select Case oWB.FileFormat
                
                                        Case 52    '// .xlsm - ALSO NEED A CHECK FOR .XLSB
                                            TempFileName = Left$(TempFileName, Len(TempFileName) - 1) & "x"
                                            oWB.SaveAs TempFileName, 51    '51=.xlsx
                
                                        Case 56  '//  .xls (97-2003)
                                            TempFileName = TempFileName & "x"
                                            oWB.SaveAs TempFileName, 51    '51=.xlsx
                                        Case 51
                                            '// Ignore XLSX files...
                                        Case Else
                                            MsgBox "Logic error - Unexpected file type.", vbExclamation, "Error"
                                            oXL.DisplayAlerts = True
                                            Err.Raise 30001, "Mail_WorkBook", "Logic error - Unexpected file type"
                                    End Select
                                    oXL.DisplayAlerts = True
                
                                    With oWB
                                        .Saved = True
                                        .Close
                                    End With
                
                                    Set olNewMail = OlApp.CreateItem(olMailItem)
                
                                    With olNewMail
                                        .To = "[email protected]"
                                        .CC = ""
                                        .BCC = ""
                                        .Subject = "New Order"
                                        .Body = " "
                                        .Attachments.Add TempFileName
                                        .Display   'Use only during debugging ##############################
                                        '.Send    'Uncomment to send e-mail ##############################
                                    End With
                
                                    '// Get rid of temporary working files.
                                    '// Outlook will have a cached copy until the email si deleted.
                                    If Dir(strExtractName) <> vbNullString Then
                                        Kill strExtractName
                                    End If
                
                                    If Dir(TempFileName) <> vbNullString Then
                                        Kill TempFileName
                                    End If
                
                                End If
                
                            End If
                
                        End If
                    Next
                
                    oXL.Application.Quit
                    Set oXL = Nothing
                
                End Sub
                It loads, and saves, XLSM and XLS files, as XLSX and have added a check to see if the file being processed is already an XLSX so no extra processing is done on it...

                Comment


                • #9
                  Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                  Thank you very much for your continued help! The only thing is, this still continues to send .xlsx files in an infinite loop, as the latest email containing a .xlsx file is converted and re-sent. I can't figure out where in the code this is failing as surely this chunk of code should sort through the file types?:

                  Code:
                                      Case 52 '// .xlsm - ALSO NEED A CHECK FOR .XLSB                        
                                          TempFileName = Left$(TempFileName, Len(TempFileName) - 1) & "x" 
                                          oWB.SaveAs TempFileName, 51 '51=.xlsx
                                           
                                      Case 56 '//  .xls (97-2003)
                                          TempFileName = TempFileName & "x" 
                                          oWB.SaveAs TempFileName, 51 '51=.xlsx
                                      Case 51 
                                           '// Ignore XLSX files...
                                      Case Else 
                                          MsgBox "Logic error - Unexpected file type.", vbExclamation, "Error" 
                                          oXL.DisplayAlerts = True 
                                          Err.Raise 30001, "Mail_WorkBook", "Logic error - Unexpected file type" 
                                      End Select

                  Comment


                  • #10
                    Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                    I can't replicate that...

                    Just to make absolutely sure, the code I am running is below, can you compare to what you are running? (I know there is 1 change - I added a '.CLOSE(olSave)' rather than use .DISPLAY).
                    Code:
                    Sub Mail_workbook_Outlook_2()
                    
                        ' This macro will run in Excel 2007 and 2010.
                        ' It will send the Active File in an Outlook e-mail as an attachment.
                        ' If the active file is .xls or .xlsm, it could contain macros, so
                        ' the file is saved as .xlsx and then e-mailed.
                        ' If the file is .xlsx, no copy is made, the file is just sent.
                        ' This macro is designed to only send .xls, .xlsx or .xlsm files.
                        ' In all cases the file is sent as .xlsx.
                        '
                        Dim oWB As Object
                        Dim oXL As Object
                    
                        Dim TempFilePath As String
                        Dim TempFileName As String
                    
                        Dim strExtractName As String
                        Dim strNewName As String
                    
                        '// A general counter...
                        Dim lngMsgIndex As Long
                    
                        '// Main Outlook objects
                        Dim OlApp As Outlook.Application
                        Dim olThisMail As Outlook.MailItem
                        Dim olNewMail As Outlook.MailItem
                    
                        '// Other Outlook objects
                        '// The current OutLook message list
                        Dim OlExp As Outlook.Explorer
                        '// Selected (Highlighted) messages
                        Dim OlSel As Outlook.Selection
                        '// A Single mail message
                        Dim oMail As Outlook.MailItem
                    
                        '// this is more for a shortcut than anything else
                        Set OlApp = Outlook.Application
                    
                        '// refer to OutLook Explorer
                        Set OlExp = Application.ActiveExplorer
                    
                        '// And get a reference to selected items
                        Set OlSel = OlExp.Selection
                    
                        '// Start Excel...
                        Set oXL = CreateObject("Excel.Application")
                    
                        If Val(oXL.Application.Version) < 12 Then
                            oXL.Application.Quit
                            Set oXL = Nothing
                            MsgBox "This procedure can only run in Excel 2007 or newer...", vbExclamation, "Error"
                            Exit Sub
                        End If
                    
                        TempFilePath = Environ$("temp") & "\"
                    
                        '// For each selected item in the Explorer bar
                        For lngMsgIndex = 1 To OlSel.Count
                    
                            '// Only interested in Mail items. Can be easily extended to include
                            '// Appointemnts, Calendar items etc.
                            If OlSel.Item(lngMsgIndex).Class = OlObjectClass.OlMail Then
                    
                                '// Set a reference to this mail item
                                Set olThisMail = OlSel.Item(lngMsgIndex)
                    
                                '// Assuming (for simplicity) there is only one attachment...
                                If olThisMail.Attachments.Count = 1 Then
                    
                                    '// Is this an Excel file...?
                                    If InStr(olThisMail.Attachments.Item(1).fileName, ".xls") > 0 Then
                    
                                        '/ Save it to the temporary directory
                                        TempFileName = TempFilePath & olThisMail.Attachments.Item(1).fileName
                    
                                        '// Store the extracted file name
                                        strExtractName = TempFileName
                    
                                        '// Just in case - delete any existing
                                        If Dir(TempFileName) <> vbNullString Then
                                            Kill TempFileName
                                        End If
                    
                                        '// And save.
                                        olThisMail.Attachments.Item(1).SaveAsFile TempFileName
                    
                                        '// Open the saved attachment in Excel...
                                        Set oWB = oXL.WorkBooks.Open(fileName:=TempFileName, AddToMRU:=False)
                    
                                        '// Prevent warning dialogues...
                                        oXL.DisplayAlerts = False
                    
                                        Select Case oWB.FileFormat
                    
                                            Case 52    '// .xlsm - ALSO NEED A CHECK FOR .XLSB
                                                TempFileName = Left$(TempFileName, Len(TempFileName) - 1) & "x"
                                                oWB.SaveAs TempFileName, 51    '51=.xlsx
                    
                                            Case 56  '//  .xls (97-2003)
                                                TempFileName = TempFileName & "x"
                                                oWB.SaveAs TempFileName, 51    '51=.xlsx
                                            Case 51
                                                '// Ignore XLSX files...
                                            Case Else
                                                MsgBox "Logic error - Unexpected file type.", vbExclamation, "Error"
                                                oXL.DisplayAlerts = True
                                                Err.Raise 30001, "Mail_WorkBook", "Logic error - Unexpected file type"
                                        End Select
                                        oXL.DisplayAlerts = True
                    
                                        With oWB
                                            .Saved = True
                                            .Close
                                        End With
                    
                                        Set olNewMail = OlApp.CreateItem(olMailItem)
                    
                                        With olNewMail
                                            .To = "[email protected]"
                                            .CC = ""
                                            .BCC = ""
                                            .Subject = "New Order"
                                            .Body = " "
                                            .Attachments.Add TempFileName
                    
                                           ' .Display   'Use only during debugging ##############################
                                            .Close (olSave)
                                            '.Send    'Uncomment to send e-mail ##############################
                    
                                        End With
                    
                                        '// Get rid of temporary working files.
                                        '// Outlook will have a cached copy until the email si deleted.
                                        If Dir(strExtractName) <> vbNullString Then
                                            Kill strExtractName
                                        End If
                    
                                        If Dir(TempFileName) <> vbNullString Then
                                            Kill TempFileName
                                        End If
                    
                                    End If
                    
                                End If
                    
                            End If
                        Next
                    
                        oXL.Application.Quit
                        Set oXL = Nothing
                    
                    End Sub
                    I have a TEST folder in Outlook. Create some mail messages with attachments - 2 XLSX, 1 XLSM & 1 XLS. At the end of the procedure there are 4 messages with XLSX attachments in the Drafts folder.

                    Comment


                    • #11
                      Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                      Originally posted by cytop View Post
                      I have a TEST folder in Outlook. Create some mail messages with attachments - 2 XLSX, 1 XLSM & 1 XLS. At the end of the procedure there are 4 messages with XLSX attachments in the Drafts folder.
                      I'll admit, my issue could be that I'm running this code as a module attached to an Outlook rule.. (I can't seem to get it to do anything when in 'ThisOutlookSession') But surely, in your example above, only two of the files should be converted, therefore leaving two drafts as two are already in the correct format? Unless your procedure will convert all files to .xlsx regardless, and move the original .xlsx, .xlsm and .xls files to another folder?

                      Apologies for not understanding this, you really have been so helpful which I appreciate!

                      Edit: Otherwise, when the drafts are sent, the macro will run again on the new .xlsx files.

                      Comment


                      • #12
                        Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                        OK - so maybe the rule is complicating things.

                        Breifly, the code runs against selected items in an OutLook Explorer bar. This is the summary list of messages in a folder.

                        Referring back to my first post in this thread:
                        I might also suggest the running this off the Inbox might not be a good idea (at least, I'm assuming that's where the rule runs...). It would be more sensible to have a rule that moves incoming mails to a separate folder and this code is then run against that folder.
                        So, what I will suggest to test this is that you create a folder and place a couple of messages in there. Select/Highlight whichever messages you want to process on the Explorer bar when viewing that folder and run the procedure. You should end up with however many messages in the Drafts folder.

                        If you can confirm that works as you'd expect it to then we can see about running it from the rule... or perhaps you can just start it manually as described above and most processed messages to another folder.

                        Comment


                        • #13
                          Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                          That works great, although regardless of extension (.xlsx, .xlsm, .xls) a new draft is created.

                          Ideally, I'd like only .xlsm files to be converted and any other file type ignored. Is this possible?

                          Comment


                          • #14
                            Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                            Code:
                                               Case 52 '// .xlsm - ALSO NEED A CHECK FOR .XLSB
                                                    TempFileName = Left$(TempFileName, Len(TempFileName) - 1) & "x" 
                                                    oWB.SaveAs TempFileName, 51 '51=.xlsx
                                                     
                                                Case 56 '//  .xls (97-2003)
                                                    '// IGNORE
                                                    '// TempFileName = TempFileName & "x" 
                                                    '// oWB.SaveAs TempFileName, 51 '51=.xlsx
                                                Case 51 
                                                     '// Ignore XLSX files...
                            BUT: you must leave the Case Statements there. Otherwise it'll fall into the Case Else block and think they are invalid file types.

                            For completeness, if you want to add support for XLSB files then
                            Code:
                                              Case 52, 50  '// Note 50

                            Comment


                            • #15


                              Re: VBA: Convert excel attachment from .xlsm to .xlsx and re-send

                              Thank you again! I've had to add 'Exit Sub' to each of the cases to ensure that nothing happens to the files which do not be converted.

                              My only other question would be, could the code be adapted easily to work on emails with multiple attachments?

                              Comment

                              Working...
                              X