Export Outlook email data to macro enabled Excel workbook

Question

I have code in Outlook to export data, from emails in a selected folder, to an Excel Workbook.

In that workbook I have VBA code to parse the data (the subject line for now, eventually the body).

When I export from Outlook to a ".xlsx" file everything looks great.
When I export to my ".xlsm" file it adds columns with information that does not align with the correct imported information.

Ex: Column A & B are correct, A is the CreationTime, B is the full SubjectLine

Column C, D, E, etc. will be random parsed bits of subject lines.

Are the macros in the Excel workbook running when the export to Excel is happening?

If so, how can I prevent that?

My Outlook code:

Sub ExportToExcel()
    On Error GoTo ErrHandler
    Dim appExcel As Excel.Application
    Dim wkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rng As Excel.Range
    Dim strSheet As String
    Dim strPath As String
    Dim intRowCounter As Integer
    Dim intColumnCounter As Integer
    Dim msg As Outlook.MailItem
    Dim nms As Outlook.NameSpace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object

    'Opens the Workbook and Sheet to paste in
    strSheet = "Tester.xlsx"
    strPath = "G:\Jason\"
    strSheet = strPath & strSheet

    Debug.Print strSheet
    'Select export folder
    Set nms = Application.GetNamespace("MAPI")
    Set fld = nms.PickFolder

    'Handle potential errors with Select Folder dialog box.
     
    If fld Is Nothing Then
        MsgBox "There are no mail messages to export", vbOKOnly, "Error"
        Exit Sub

    ElseIf fld.DefaultItemType <> olMailItem Then
        MsgBox "There are no mail messages to export", vbOKOnly, "Error"
        Exit Sub

    ElseIf fld.Items.Count = 0 Then
        MsgBox "There are no mail messages to export", vbOKOnly, "Error"
        Exit Sub
    End If

    'Open and activate Excel workbook.

    Set appExcel = CreateObject("Excel.Application")
    appExcel.Workbooks.Open (strSheet)
    Set wkb = appExcel.ActiveWorkbook
    Set wks = wkb.Sheets(1)
    wks.Activate
    appExcel.Application.Visible = True

    'Copy field items in mail folder.

    For Each itm In fld.Items
        intColumnCounter = 1

        Set msg = itm
        intRowCounter = intRowCounter + 1

        Set rng = wks.Cells(intRowCounter, intColumnCounter)
        rng.Value = msg.CreationTime

        intColumnCounter = intColumnCounter + 1

        Set rng = wks.Cells(intRowCounter, intColumnCounter)
        rng.Value = msg.Subject

    Next itm

    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
    Exit Sub

ErrHandler:  
    If Err.Number <> 0 Then
        MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
    End If

    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
End Sub

Parsing code in Excel:

Sub SplitSubjectLine()

    Dim text As String
    Dim i As Integer
    Dim y As Integer
    Dim LastRow As Long
    Dim name As Variant

    ReDim name(3)

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    For y = 1 To LastRow
        Cells(y, 2).Select
        text = ActiveCell.Value
        name = Split(text, ",")
    
        For i = 0 To UBound(name)
            Cells(y, i + 2).Value = name(i)
        Next i
    Next
End Sub

Answer 1

You need to wrap your actions in Excel with :

• appExcel.EnableEvents = False (before your actions in Excel) and
• appExcel.EnableEvents = True when you are done in Excel

Pseudo code :

''Start of your sub

Set appExcel = CreateObject("Excel.Application")
appExcel.EnableEvents = False

''Your actions in Excel

appExcel.EnableEvents = True

''End of your sub