Question

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

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

Answer 1

现在，您正在使用以下行创建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")

重用已从Outlook打开Excel工作表

1 个答案: