重用已从Outlook打开的Excel工作表

我正在从Outlook导入数据。打开Excel的代码将打开一个未加载personal.xlsb的实例，并将打开多个Excel实例。如果我运行它两次，它将打开两个实例，但将覆盖第一个实例中的数据，而第二个实例将保留一个空白工作簿。如果Excel已关闭而Outlook未关闭，则运行代码时，它将给出一个错误，因为它不会将数据放入新的“第二个”实例，即使只有一个实例正在运行

Sub Extract()
    On Error GoTo 0
    Set myOlApp = Outlook.Application
    Set mynamespace = myOlApp.GetNamespace("mapi")

    Dim ThermoMail As Outlook.MailItem
    Set ThermoMail = Application.ActiveInspector.CurrentItem

    Set xlobj = CreateObject("excel.application")
    xlobj.Visible = True
    xlobj.Workbooks.Add
    'Set Headings

    Dim msgText, delimtedMessage, Delim1 As String
    delimtedMessage = ThermoMail.Body

    'Remove everything before "Lead Source:" and after "ELMS"
    TrimmedArray = Split(delimtedMessage, "Source:")
    delimtedMessage = TrimmedArray(1)
    TrimmedArray = Split(delimtedMessage, "ELMS")
    delimtedMessage = TrimmedArray(0)

    'Split the array at each return
    messageArray = Split(delimtedMessage, vbCrLf)
    'this next line gives the error if excel is closed and the macro is rerun.
    Range("A1:A" & UBound(messageArray) + 1) = WorksheetFunction.Transpose(messageArray)
    Call splitAtColons

End Sub

---

现在，您正在使用以下行创建一个新的Excel实例：

 Set xlobj = CreateObject("excel.application")

Excel与某些（大多数）Office应用程序不同，因为它可以运行多个实例（PowerPoint、Outlook、Word不能这样做…）

因此，您要做的是首先检查是否有Excel的打开实例，并使用它。仅当没有实例已打开时才创建新实例

On Error Resume Next
Set xlObj = GetObject(, "Excel.Application")
On Error GoTo 0
If xlObj Is Nothing Then Set xlObj = CreateObject("Excel.Application")