Open, edit and then save Excel file multiple times using Outlook VBA

Question

I am working on a "mail bot", where I will receive a filled template, and populate and save an Excel file with that information.

I can fill the first file and quit the Excel file.

When a second mail arrives, I get

'1004 - application-defined or object-defined error'

Why am I getting the error on the second and beyond ones?

I am running the code when a new mail arrives

Option Explicit

Private WithEvents inboxItems As Outlook.Items

Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.NameSpace

    Set outlookApp = Outlook.Application
    Set objectNS = outlookApp.GetNamespace("MAPI")
    Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

The main sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg         As Outlook.MailItem
    Dim MessageInfo
    Dim Result
    Dim splitter()  As String
    Dim splitter2() As String
    Dim str         As Variant
    Dim LoopCali    As Integer
    Dim xlApp       As Object
    Dim sourceWB    As Workbook
    Dim sourceWS    As Worksheet
    Dim strFile     As String

    If TypeName(Item) = "MailItem" Then
        If InStr(Item.Subject, "BOT") > 0 Then
            splitter = Split(Item.Body, vbCrLf)
            splitter2 = Split(splitter(40), "-")

            Set xlApp = CreateObject("Excel.Application")
            strFile = "C:\Users\e1257539\Desktop\SMOBOT\SMO_TOOL_BOT.xlsm"
            With xlApp
                .Visible = TRUE
                .EnableEvents = FALSE
            End With
            Set sourceWB = Workbooks.Open(strFile, , False, , , , , , , True)
            sourceWB.Activate

            With xlApp
                .Worksheets("HEADER").Range("D6").Value2 = splitter(22)
                .Worksheets("HEADER").Range("D8").Value2 = splitter(12)
                .Worksheets("HEADER").Range("F4").Value2 = "AINT"
                .Worksheets("HEADER").Range("F3").Value2 = "EXW"
                .Worksheets("HEADER").Range("C2").Value2 = Worksheets("QuoteSTG").Range("A" + CStr(Worksheets("QuoteSTG").Range("B1").Value2)).Value2
                .Worksheets("QuoteSTG").Range("A" + CStr(Worksheets("QuoteSTG").Range("B1").Value2)).Value2 = ""
            End With

            If splitter(2) = "Calibração" Then
                Result = MsgBox(splitter(2), vbOKOnly, i)
                LoopCali = splitter(26)

            End If
            If splitter(2) = "Trainamento" Then

            End If

        End If
        MessageInfo = "" & _
                      "Sender : " & Item.SenderEmailAddress & vbCrLf & _
                      "Sent : " & Item.SentOn & vbCrLf & _
                      "Received : " & Item.ReceivedTime & vbCrLf & _
                      "Subject : " & Item.Subject & vbCrLf & _
                      "Size : " & Item.Size & vbCrLf & _
                      "Message Body : " & vbCrLf & Item.Body

    End If
    xlApp.Quit
    Set xlApp = Nothing
    Set sourceWB = Nothing
    Set sourceWS = Nothing
    ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    xlApp.Quit
    Set xlApp = Nothing
    Set sourceWB = Nothing
    Set sourceWS = Nothing
    'Resume ExitNewItem
End Sub

I get the error on "Set sourceWB = Workbooks.Open(strFile, , False, , , , , , , True)" — Laharl Krichevki, Nov 21 '19 at 22:22
You neither save nor close the file in the code provided. You have to be thorough when cleaning up the Excel references. https://stackoverflow.com/questions/24374763/excel-application-not-closing-from-outlook-vba-function — niton, Nov 22 '19 at 01:49
@niton , I was using `xlApp.Quit Set xlApp = Nothing Set sourceWB = Nothing Set sourceWS = Nothing`, Now i also included `sourceWB.Close sourceWB.Save` But i'm still getting the same error, Any ideas on why the error still there? — Laharl Krichevki, Nov 22 '19 at 12:12
I'll try setting the objects (Ws/ Wb) as the example you sent — Laharl Krichevki, Nov 22 '19 at 12:21
Changing the worksheet and workbook types to "object" solved the issue! Thank you for your help! — Laharl Krichevki, Nov 22 '19 at 17:33

score 0 · Accepted Answer · answered Nov 22 '19 at 17:40

As checked on the link sent by the user: Niton

Excel application not closing from Outlook VBA function

The main issue was that the excel file wasn't closing.

After some changes this was the final result:

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    Dim Msg         As Outlook.MailItem
    Dim MessageInfo
    Dim Result
    Dim splitter()  As String
    Dim splitter2() As String
    Dim str         As Variant
    Dim LoopCali    As Integer
    Dim i           As Integer
    Dim xlApp       As Object
    Dim sourceWB    As Object
    Dim Header, QuoteSTG, AINT As Object
    Dim strFile     As String
    Dim file_name   As String

    '
    i = 0

    '

    If TypeName(Item) = "MailItem" Then
        If InStr(Item.Subject, "BOT") > 0 Then
            splitter = Split(Item.Body, vbCrLf)
            splitter2 = Split(splitter(40), "-")
            Result = MsgBox(splitter2(0), vbOKOnly, i)
            Result = MsgBox(splitter2(1), vbOKOnly, i)

            '

            Set xlApp = CreateObject("Excel.Application")
            strFile = "C:\Users\e1257539\Desktop\SMOBOT\SMO_TOOL_BOT.xlsm"
            With xlApp
                .Visible = True
                .EnableEvents = False
            End With
            Set sourceWB = Workbooks.Open(strFile)
            sourceWB.Activate
            Set Header = sourceWB.Sheets(4)        'header
            Set QuoteSTG = sourceWB.Sheets(13)        'quotestg
            Set AINT = sourceWB.Sheets(7)        'aint

            If splitter(2) = "Calibração" Then
                LoopCali = splitter(26)
                file_name = QuoteSTG.Range("A" + CStr(QuoteSTG.Range("B1").Value2)).Value2
                QuoteSTG.Range("A" + CStr(QuoteSTG.Range("B1").Value2)).Value2 = ""
                sourceWB.Save
                Header.Range("D6").Value2 = splitter(22)
                Header.Range("D8").Value2 = splitter(12)
                Header.Range("F4").Value2 = "AINT"
                Header.Range("F3").Value2 = "EXW"
                Header.Range("C2").Value2 = file_name
            End If
            If splitter(2) = "Treinamento" Then

            End If

        End If

    End If

    MkDir "C:\Users\e1257539\Desktop\SMOBOT\" + file_name
    sourceWB.SaveAs FileName:="C:\Users\e1257539\Desktop\SMOBOT\" + file_name + "\" + file_name
    sourceWB.Close
    xlApp.Quit
    Set xlApp = Nothing
    Set sourceWB = Nothing
    Set AINT = Nothing
    Set QuoteSTG = Nothing
    Set Header = Nothing
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
End Sub

Open, edit and then save Excel file multiple times using Outlook VBA

1 Answers1