Question

我创建了一个将Outlook邮件复制到Excel工作表的Outlook宏。

当目标工作簿已经打开时，宏不会给出预期的结果。我想关闭已打开的工作簿。

我知道如何使用Excel VBA进行此操作，但如何使用Outlook VBA处理此问题。

我使用以下代码检查Excel工作表是否已打开。

请注意，我想使用Outlook VBA关闭打开的工作簿。

Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0

Select Case ErrNo
Case 0:    IsWorkBookOpen = False
Case 70:   IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function

更新 - 1（我用来打开和填充工作簿的代码）

    Dim xlWB As Object
    Dim xlSheet As Object
    Dim xlApp As Object

    Set xlApp = CreateObject("Excel.Application")
    Set xlWB = xlApp.workbooks.Open(xlPath)
    Set xlSheet = xlWB.sheets("output")

    NextRow = xlSheet.Range("A" & xlApp.Rows.Count).End(3).Row + 1

    With xlSheet
        .cells(NextRow, "A") = Item.Subject
        .cells(NextRow, "B") = Item.ReceivedTime
        .cells(NextRow, "C") = xAsset
        .cells(NextRow, "D") = Item.SenderName
        .cells(NextRow, "E") = Item.SenderEmailAddress
    End With

    xlWB.Save
    xlWB.Close SaveChanges:=True
    xlApp.Quit
    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing

更新 - 2（解决方案）

Dim wb As Object
Set wb = GetObject("C:\book1.xlsx")
If Not wb is Nothing then wb.close

Answer 1

您知道，您可以使用GetObject检索实际文档本身，而无需打开应用程序并添加工作簿。如果工作簿已经打开，它将为您提供已打开实例的引用，否则它将为您打开它。这应该可以让你避免这个问题;）

像：

Dim wb As Object
Set wb = GetObject("C:\book1.xlsx")
If not wb is nothing then debug.print wb.Name

您可以使用以下内容访问现有的Excel实例。您需要添加对Microsoft Excel对象库的引用（工具＆gt;引用）或将Dim xlapp和Dim wb的类型更改为As Object。我个人更喜欢添加引用以保持智能感知和早期绑定/编译器检查。

'Gets an existing instance of Excel if running then closes workbooks open in the instance,
'otherwise exits
Sub blah()
    Dim xlapp As Excel.Application

    On Error Resume Next
    Set xlapp = GetObject(, "Excel.Application")
    On Error GoTo 0

    If xlapp Is Nothing Then
        'No instance was running. You can create one with
        'Set xlapp = New Excel.Application
        'but in your case it doesn't sound like you need to so:
        Exit Sub
    End If

    Dim wb As Workbook
    For Each wb In xlapp.Workbooks
        wb.Close False
    Next wb

    xlapp.Quit

End Sub

当多个正在运行时获取特定应用程序实例的过程非常不同，所以如果您需要该请求，请说明。

关闭已在Outlook VBA中打开的工作簿

1 个答案: