Outlook VBA代码更新工作表后Excel文档锁定为只读

我修改了代码，用于检查新Outlook电子邮件的主题行中的关键字，打开工作簿并将某些信息粘贴到此工作簿中：

Option Explicit

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")

  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items

End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

  On Error GoTo ErrorHandler

  Dim Msg As Outlook.MailItem

  If TypeName(item) = "MailItem" Then
    Set Msg = item
    If InStr(Msg.Subject, "Re:") > 0 Then
        Exit Sub
    ElseIf InStr(Msg.Subject, "MDI Board") > 0 Then '// Keyword goes here

        '// Declare all variables needed for excel functionality and open appropriate document
        Dim oXL As Object
        Dim oWS As Object
        Dim lngRow As Long

        Set oXL = CreateObject("Excel.Application")
        oXL.Workbooks.Open FileName:="T:\Capstone Proj\TimeStampsOnly.xlsx", AddTOMRU:=False, UpdateLinks:=False

        '// Change sheet name to suit
        Set oWS = oXL.Sheets("TimeStamps")
        lngRow = oWS.Range("A" & oXL.Rows.Count).End(-4162).Offset(1).Row '// -4162 = xlUp. not available late bound

        With oWS
            .cells(lngRow, 1).Value = Msg.SenderName
            .cells(lngRow, 2).Value = Msg.ReceivedTime
            .cells(lngRow, 3).Value = Msg.ReceivedByName
            .cells(lngRow, 4).Value = Msg.Subject
            .cells(lngRow, 5).Value = Msg.Body

        '// And others as needed - you will have Intellisense

        End With

        With oXL
            .activeworkbook.Save
            .activeworkbook.Close SaveChanges:=2   '// 2 = xlDoNotSaveChanges but not availabe late bound
            .Application.Quit
        End With

        Set oXL = Nothing
        Set oWS = Nothing

    End If
  Else
    Exit Sub
  End If

ExitPoint:

  Exit Sub

ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ExitPoint

  '// Debug only
  Resume

End Sub

Outlook VBA代码运行后，我无法访问工作簿。它会出现多个错误，例如“工作簿已打开”，即使我的计算机上没有运行Excel实例，或“此文件为只读”等

我试图通过使用另一个带有更新宏的工作簿来避免此问题，该宏将使用有问题的工作簿中的信息更新仪表板，但是，当我尝试使用Outlook数据为工作簿设置变量时，出现“下标超出范围”错误

Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set wkb = Excel.Workbooks("T:\Capstone Proj\TimeStampsOnly.xlsx")
Set wks = wkb.Worksheets("Timestamps")

瓦格纳·布拉加

我过去也有过类似的问题。在我的例子中，我不是在寻找包含某些字符的主题，而是寻找等于字符串的主题。无论如何，这与你的问题无关

我发现，像你一样，我的代码在试图将电子邮件中的信息输入Excel时出错。我确实读过关于你问题的评论，知道你不想使用不必要的计算能力。我的方法不是完成你想做的事情的最有效的方法，但这是我能做到的唯一方法

首先，我没有从Outlook VBA编辑Excel工作簿。我试图这么做，但这是我的代码出错的地方。相反，我将email对象设置为变量的值（以便于引用）。然后我使用

Split（…）

函数将我想要的电子邮件中的信息读取到一个数组中。代码创建了一个文本文件并将数据写入其中，以便Excel可以访问该文件。在从电子邮件中写入数据之前，我还在第一行中写入了文本“

！NEWDATA！

”。您可以使用任何您想要的字符串，只要顶部有一个唯一的标识符，以便Excel识别它应该从文件中获取数据。然后我打开了工作簿，就像使用VBA打开任何其他文件一样

现在，Excel workboook还需要一些VBA代码，我的方法才能工作。在工作簿代码的

Workbook\u Open（）

VBA子文件中，Excel应读取第一行或第一个

x

字符数。您可以使用任何一种方法，但这应该指向文件中包含“

！NEWDATA！

”或其他字符串的部分。如果此字符串是您从Outlook中写入的字符串，请继续读取该文件。如果不是，则退出子项。从这里，您可以让Excel读取文件的其余部分（您可以通过Outlook VBA选择一个delimeter分隔该文件），并将数据放入相应的单元格中。然后更改“

！NEWDATA！

”和文件的其余部分，这样，如果您手动启动Excel（并且不想导入任何数据），则

工作簿\u Open（）

子文件将停止并且不会出错。您可以将其更改为任何类似于空白文件、“

无新数据”

”或任何其他您喜欢的字符串。之后，使用VBA保存工作簿并将其关闭

您可能知道，如果不希望用户看到工作簿，可以将Excel窗口的

Visible

属性设置为

False

---

如果您有任何问题或意见，请告诉我。我很乐意回答您的任何问题。

请参见第二个示例-如果工作簿打开时出现代码错误，它将不会关闭，Excel实例将保持打开状态。检查您的任务管理器是否有Excel实例仍在运行。@TimWilliams在编写此文件之前，我已经检查了几次我的任务管理器，以确保没有任何东西在运行，并且它仍然抛出错误。如果工作簿尚未打开，则需要打开它：

Set wkb=Excel.Workbooks.open（“t:\Capstone Proj\timessonly.xlsx”）

@TimWilliams这消除了我的“下标超出范围”错误，尽管我不喜欢花费计算机资源打开然后关闭工作簿，只是为了捕获单元格值，但这似乎是唯一的方法-在调用时间戳工作簿时，outlook VBA中是否存在导致“被另一个用户锁定以供编辑”的任何内容？excel似乎将outlook宏视为一个人，并在运行后锁定该文件