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

Question

我已经修改了检查新 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 的实例或“此文件是只读的”等，它也会给出多个错误，例如“工作簿已打开”等。

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

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

Answer 1

瓦格纳布拉加!

我过去也遇到过类似的问题。就我而言，我不是在寻找包含某些字符的主题，而是在寻找等于字符串的主题。无论哪种方式，这与您的问题无关。

我发现，和你的一样，我的代码在尝试将电子邮件中的信息放入 Excel 时出错。我确实阅读了有关您问题的评论，并且知道您不想使用不必要的计算能力。我的方法不是完成你想做的最有效的方法，但它是我能做到的唯一方法。

首先，我没有从 Outlook VBA 编辑 Excel 工作簿。我试图这样做，但这是我的代码出错的地方。相反，我将电子邮件对象设置为变量的值(以便于引用)。然后我使用 Split(...) 将我想要的电子邮件中的信息读取到一个数组中。功能。该代码创建了一个文本文件并将数据写入其中，以便 Excel 可以访问它。在写电子​​邮件中的数据之前，我还在第一行写了文本“!NEWDATA!”。您可以使用任何您想要的字符串，只要顶部有一个唯一标识符，以便 Excel 识别它应该从文件中获取数据。然后我打开了工作簿，就像我使用 VBA 打开任何其他文件一样。

现在，Excel 工作簿也需要一些 VBA 代码才能使我的方法正常工作。在 Workbook_Open()工作簿代码中的 VBA 子代码，Excel 应读取第一行或第一个 x字符数。您可以使用任何一种方法，但这应该指向文件中包含“!NEWDATA!”或其他字符串的部分。如果此字符串是您从 Outlook 写入的字符串，请继续阅读该文件。如果不是，Exit Sub .从这里您可以让 Excel 读取文件的其余部分(通过 Outlook VBA 用您选择的分隔符分隔)并将数据放入相应的单元格中。然后更改“!NEWDATA!”和文件的其余部分，这样如果您手动启动 Excel(并且您不想导入任何数据)Workbook_Open() sub 将停止而不是错误。您可以将其更改为任何内容，例如空白文件“No new data”或您喜欢的任何其他字符串。之后，使用 VBA 保存工作簿并关闭它。

您可能知道，您可以设置 Excel 窗口的 Visible属性(property)给 False如果您不希望用户看到工作簿。

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