Visual Basic(VBA 7.0):从Outlook文件夹导出电子邮件时出现运行时错误“91”

时间:2018-03-17 16:52:41

标签: vba email outlook outlook-vba

我使用以下VB脚本将当前Outlook文件夹中的所有电子邮件导出到.csv文件。

该文件夹包含超过13,000封电子邮件。该脚本成功导出大约5700封电子邮件,但随后出现运行时错误“91”:“对象变量或未设置块变量”。

您能否告知导致运行时错误的原因。

顺便说一句,这个脚本速度很慢,是否可以更改以使其更快?

Sub ExportMessagesToCsv()
    Dim olkMsg As Object, _
        strFilename As String, _
        emailAttributes As String, _
        folderItems As Items

    strFilename = "C:\temp\folder-emails.csv"
    Open strFilename For Output As #1

    Set folderItems = Application.ActiveExplorer.CurrentFolder.Items
    Dim itemCounter As Integer
    For itemCounter = 1 To folderItems.count
        Debug.Print ("**" & itemCounter)
        Set olkMsg = folderItems.Item(itemCounter)

        'Only export messages
        If olkMsg.Class = olMail Then
            'Add a row for each field in the message you want to export
            emailAttributes = EncloseInDoubleQuotes(olkMsg.Subject) + "," + _
                            EncloseInDoubleQuotes(olkMsg.Body) + "," + _
                            EncloseInDoubleQuotes(olkMsg.Sender) + "," + _
                            EncloseInDoubleQuotes(olkMsg.SenderEmailAddress) + "," + _
                            EncloseInDoubleQuotes(olkMsg.To) + "," + _
                            EncloseInDoubleQuotes(GetSMTPAddressForToRecipients(olkMsg))

            Print #1, emailAttributes
        End If
        Set olkMsg = Nothing
    Next itemCounter
    Close #1
End Sub

Function GetSMTPAddressForToRecipients(mail As Outlook.MailItem) As String
    On Error GoTo ErrorHandler   ' Enable error-handling routine.

    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Dim result As String
    Dim recipCounter As Integer
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    result = ""
    Set recips = mail.Recipients        
    For recipCounter = 1 To recips.count
        Set recip = recips.Item(recipCounter)
        If recip.Type = olTo Then
            Set pa = recip.PropertyAccessor

            If result = "" Then
                result = pa.GetProperty(PR_SMTP_ADDRESS)
            Else
                result = result + ";" + pa.GetProperty(PR_SMTP_ADDRESS)
            End If
         End If
    Next recipCounter

ErrorHandler:'Error-handling: return result already generated
    GetSMTPAddressForToRecipients = result
End Function

Function EncloseInDoubleQuotes(str As String)
    EncloseInDoubleQuotes = Replace(str, """", """""")
    EncloseInDoubleQuotes = """" + EncloseInDoubleQuotes + """"
End Function

0 个答案:

没有答案