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的实例或“此文件为只读”等信息，也会出现多个错误，例如“工作簿已打开”。

我试图通过使用另一个具有更新宏的工作簿来规避此问题，该更新宏将使用有问题的工作簿中的信息来更新仪表板，但是当我尝试将变量设置为以下内容时，出现“下标超出范围”错误带有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")

Answer 1

瓦格纳·布拉加！

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

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

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

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

您可能已经知道，如果不希望用户看到工作簿，则可以将Excel窗口的Visible属性设置为False。

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

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

1 个答案: