簡體   English   中英

使用 Excel 函數后使用 Outlook VBA 關閉 Excel 應用程序

[英]Closing an Excel Application using Outlook VBA after using an Excel function

我正在為 Outlook(使用 Outlook VBA)開發一種“BOT”,在其中我通過郵件接收信息,拆分郵件正文,將其粘貼到 Excel 上並執行 Excel 宏。

添加我調用 Excel 宏的部分后,我得到

'1004 - 應用程序定義或對象定義的錯誤'

如果我第二次運行這個 + 時間。

xlApp.Application.Run "AINT.Cali_B_Click"

即使我將 Excel 變量設置為.quit並使用.close.quit ,Excel 仍在運行。

如何結束使 Excel 保持打開狀態的應用程序引用?

這是我的完整代碼:

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 loopH As String
    Dim str         As Variant
    Dim LoopCali    As Integer
    Dim i, j          As Integer
    Dim xlApp      As Object
    Dim sourceWB   As Object
    Dim Header, QuoteSTG, AINT, Treinamento As Object
    Dim strFile, file_name    As String
    Dim shellcom As String

    i = 1

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

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

            file_name = QuoteSTG.Range("A" + CStr(QuoteSTG.Range("B1").Value2)).Value2
            QuoteSTG.Range("A" + CStr(QuoteSTG.Range("B1").Value2)).Value2 = ""

            If splitter(2) = "Calibração" Then
                loopH = splitter(26)
                LoopCali = CInt(loopH)
                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
                Header.Range("C4").Value2 = "Calibração"
                Header.Range("L2").Value2 = "30"
                Header.Range("K12").Value2 = Item.Subject '< criar string?
                j = 40
                For i = 1 To LoopCali
                    splitter2 = Split(splitter(j), "-")
                    AINT.Range("N7").Value2 = splitter2(0)
                    AINT.Range("N13").Value2 = splitter2(1)
                    j = j + 2
                    If splitter(j) <> "" Then
                        AINT.Range("N14").Value2 = splitter(j)
                    End If 
                    j = j + 2
                    If splitter(j) <> "" Then
                        AINT.Range("N16").Value2 = splitter(j)
                    End If
                    j = j + 2
                    If splitter(j) <> "" Then
                        If splitter2(0) <> "RMT" Then
                            AINT.Range("N15").Value2 = splitter(j)
                        End If
                    End If
                    j = j + 2
                    If splitter(j) <> "" Then
                        AINT.Range("N17").Value2 = splitter(j)
                    End If
                    j = j + 2
                    xlApp.Application.Run "AINT.Cali_B_Click" '< calling the excel sub 
                Next i

            End If

        End If

    End If

    'Closing excel
    MkDir "C:\Users\e1257539\Desktop\SMOBOT\" + file_name
    sourceWB.SaveAs FileName:="C:\Users\e1257539\Desktop\SMOBOT\" + file_name + "\" + file_name
    sourceWB.Close (False)
    xlApp.Quit
    Set xlApp = Nothing
    Set sourceWB = Nothing
    Set AINT = Nothing
    Set QuoteSTG = Nothing
    Set Header = Nothing

ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    If Not sourceWB Is Nothing Then
        sourceWB.Close (False)
    End If
    If Not xlApp Is Nothing Then
        xlApp.Quit
    End If
    Set xlApp = Nothing
    Set sourceWB = Nothing
    Set AINT = Nothing
    Set QuoteSTG = Nothing
    Set Header = Nothing
End Sub

原來使用xlApp.Application.Run "AINT.Cali_B_Click"xlApp.Application.Run sourceWB.Name & "AINT.Cali_B_Click"在 VBA 代碼上留下了開放引用。

在不保留任何打開的情況下調用代碼的方法是使用CallByName

如同Call CallByName(AINT, "Cali_B_Click", VbMethod)

這樣,VBA 代碼就可以調用該函數並根據需要運行多次,而不會出現當前錯誤。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM