VBA运行时错误“-2147221233(8004010f)”

我正在尝试运行下面提到的VBA代码。

VBA代码用于从Microsoft Outlook中用户select的单个文件夹中提取电子邮件信息,并列出Microsoft Excel中的响应时间。

这是我尝试运行时收到的错误消息。


“运行时错误”-2147221233(8004010f)':

该属性“ http://schemas.microsoft.com/mapi/proptag/0x003F0102 ”未知或无法find。


这是我正在使用的代码:

Option Explicit Public ns As Outlook.Namespace Private Const EXCHIVERB_REPLYTOSENDER = 102 Private Const EXCHIVERB_REPLYTOALL = 103 Private Const EXCHIVERB_FORWARD = 104 Private Const PR_LAST_VERB_EXECUTED = "http://schemas.microsoft.com/mapi/proptag/0x10810003" Private Const PR_LAST_VERB_EXECUTION_TIME = "http://schemas.microsoft.com/mapi/proptag/0x10820040" Private Const PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" Private Const PR_RECEIVED_BY_ENTRYID As String = "http://schemas.microsoft.com/mapi/proptag/0x003F0102" ' Locates best matching reply in related conversation to the given mail message passed in as oMailItem Private Function GetReply(oMailItem As MailItem) As MailItem Dim conItem As Outlook.Conversation Dim ConTable As Outlook.Table Dim ConArray() As Variant Dim MsgItem As MailItem Dim lp As Long Dim LastVerb As Long Dim VerbTime As Date Dim Clockdrift As Long Dim OriginatorID As String Set conItem = oMailItem.GetConversation ' Let Outlook and Exchange do the hard lifting to get entire converstion for email being checked. OriginatorID = oMailItem.PropertyAccessor.BinaryToString(oMailItem.PropertyAccessor.GetProperty(PR_RECEIVED_BY_ENTRYID)) If Not conItem Is Nothing Then ' we have a conversation in which we should be able to match the reply Set ConTable = conItem.GetTable ConArray = ConTable.GetArray(ConTable.GetRowCount) LastVerb = oMailItem.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED) Select Case LastVerb Case EXCHIVERB_REPLYTOSENDER, EXCHIVERB_REPLYTOALL ', EXCHIVERB_FORWARD ' not interested in forwarded messages VerbTime = oMailItem.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME) VerbTime = oMailItem.PropertyAccessor.UTCToLocalTime(VerbTime) ' convert to local time ' Debug.Print "Reply to " & oMailItem.Subject & " sent on (local time): " & VerbTime For lp = 0 To UBound(ConArray) If ConArray(lp, 4) = "IPM.Note" Then ' it is a mailitem Set MsgItem = ns.GetItemFromID(ConArray(lp, 0)) 'mail item to check against If Not MsgItem.Sender Is Nothing Then If OriginatorID = MsgItem.Sender.ID Then Clockdrift = DateDiff("s", VerbTime, MsgItem.SentOn) If Clockdrift >= 0 And Clockdrift < 300 Then ' Allow for a clock drift of up to 300 seconds. This may be overgenerous Set GetReply = MsgItem Exit For ' only interested in first matching reply End If End If End If End If Next Case Else End Select End If ' as we exit function GetMsg is either Nothing or the reply we are interested in End Function Public Sub ListIt() Dim myOlApp As New Outlook.Application Dim myItem As Object ' item may not necessarily be a mailitem Dim myReplyItem As Outlook.MailItem Dim myFolder As Folder Dim xlRow As Long Set ns = myOlApp.GetNamespace("MAPI") ' Initialise Outlook access Set myFolder = ns.PickFolder() ' for the sake of this example we just pick a folder. InitSheet ActiveSheet ' initialise the spreadsheet xlRow = 3 For Each myItem In myFolder.Items If myItem.Class = olMail Then Set myReplyItem = GetReply(myItem) ' this example only deals with mailitems If Not myReplyItem Is Nothing Then ' we found a reply PopulateSheet ActiveSheet, myItem, myReplyItem, xlRow xlRow = xlRow + 1 End If End If DoEvents ' cheap and nasty way to allow other things to happen Next MsgBox "Done" End Sub Private Sub InitSheet(mySheet As Worksheet) With mySheet .Cells.Clear .Cells(1, 1).FormulaR1C1 = "Received" .Cells(2, 1).FormulaR1C1 = "From" .Cells(2, 2).FormulaR1C1 = "Subject" .Cells(2, 3).FormulaR1C1 = "Date/Time" .Cells(1, 4).FormulaR1C1 = "Replied" .Cells(2, 4).FormulaR1C1 = "From" .Cells(2, 5).FormulaR1C1 = "To" .Cells(2, 6).FormulaR1C1 = "Subject" .Cells(2, 7).FormulaR1C1 = "Date/Time" .Cells(2, 8).FormulaR1C1 = "Response Time" End With End Sub Private Sub PopulateSheet(mySheet As Worksheet, myItem As MailItem, myReplyItem As MailItem, xlRow As Long) Dim recips() As String Dim myRecipient As Outlook.Recipient Dim lp As Long With mySheet .Cells(xlRow, 1).FormulaR1C1 = myItem.SenderEmailAddress .Cells(xlRow, 2).FormulaR1C1 = myItem.Subject .Cells(xlRow, 3).FormulaR1C1 = myItem.ReceivedTime '.Cells(xlRow, 4).FormulaR1C1 = myReplyItem.SenderEmailAddress .Cells(xlRow, 4).FormulaR1C1 = myReplyItem.Sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS) ' I prefer to see the SMTP address For lp = 0 To myReplyItem.Recipients.Count - 1 ReDim Preserve recips(lp) As String recips(lp) = myReplyItem.Recipients(lp + 1).Address Next .Cells(xlRow, 5).FormulaR1C1 = Join(recips, vbCrLf) .Cells(xlRow, 6).FormulaR1C1 = myReplyItem.Subject .Cells(xlRow, 7).FormulaR1C1 = myReplyItem.SentOn .Cells(xlRow, 8).FormulaR1C1 = "=RC[-1]-RC[-5]" .Cells(xlRow, 8).NumberFormat = "[h]:mm:ss" End With End Sub 

你能帮我吗? 请让我知道,如果我可以更具体。

我注意到错误发生在声明中使用“as string”的唯一行上。 虽然这种types的声明,如果在VB中完美的罚款,它不适用于VBA。

简单地删除该行上的“as string”。