Question

我的代码应该检查我的收件箱中是否包含CSV文件的未打开电子邮件。当遇到一个邮件时，应该使用新名称下载它，并将电子邮件标记为在新文件夹中已读。

昨天一切都正常，现在我收到运行时错误91。

Option Explicit

Sub SaveAttachments()
    Dim myOlapp         As Outlook.Application
    Dim myNameSpace     As Outlook.NameSpace
    Dim myFolder        As Outlook.MAPIFolder
    Dim myItem          As Outlook.MailItem
    Dim myAttachment    As Outlook.Attachment
    Dim avDate()        As String
    Dim vDate           As String
    Dim Address         As String
    Dim i               As Long
    Dim j               As Long
    Dim csvCount        As Long
    Dim myDestFolder    As Outlook.MAPIFolder

    Const myPath As String = "C:\Saved CSV\"
    ReDim Preserve avDate(3)

    Set myOlapp = CreateObject("Outlook.Application")
    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    i = 0
    j = 0


    Set myDestFolder = myFolder.Parent.Folders("CSV Emails")

    For i = myFolder.Items.Count To 1 Step -1
        If TypeName(myFolder.Items(i)) = "MailItem" Then
            Set myItem = myFolder.Items(i)
        End If
        csvCount = 0

        If myItem.UnRead = True Then                                    'Run time error Here'
            avDate = Split(CStr(myItem.ReceivedTime), "/")
            vDate = Mid(avDate(2), 1, 4) & "-" & avDate(1) & "-" & avDate(0)


            If myItem.Attachments.Count <> 0 Then
                For Each myAttachment In myItem.Attachments
                    If LCase(Right(myAttachment.FileName, 3)) = "csv" Then
                        j = j + 1
                        csvCount = csvCount + 1

                        Dim recipientsItem As Object
                        Dim OldMessage As Outlook.MailItem
                        Set OldMessage = ActiveExplorer.Selection.Item(1)

                        For Each recipientsItem In OldMessage.Recipients
                            If OldMessage.SenderEmailType = "EX" Then
                                Address = OldMessage.Sender.GetExchangeUser.PrimarySmtpAddress
                            End If
                            If OldMessage.SenderEmailType = "SMTP" Then
                                Address = mymessage.SenderEmailAddress
                            End If
                        Next recipientsItem

                        myAttachment.SaveAsFile ((myPath) & "," & Address & "," & vDate & " - " & j & " - " & myAttachment.FileName)
                    End If
                Next myAttachment

                If csvCount > 0 Then
                    myItem.UnRead = False
                    myItem.Move myDestFolder
                End If
            End If
        End If
    Next i

SaveAttachments_exit:
  Set myAttachment = Nothing
  Set myItem = Nothing
  Set myNameSpace = Nothing
  Set OldMessage = Nothing
  Exit Sub

SaveAttachments_err:
  MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
  Resume SaveAttachments_exit


End Sub

我在

上遇到错误

If myItem.UnRead = True Then

昨天没有错误。任何帮助将不胜感激。

我认为这是因为myItem的set语句在for循环内，并且未正确设置。

对于想知道为什么在文件名中加上逗号的人，我可以在Powershell中使用-split语句提取发件人的电子邮件地址。

Answer 1

我怀疑这行Set myItem = myFolder.Items(i)从未执行过，这将导致您的If指令无法访问对象属性。

这可能是由于多种原因造成的：

Outlook 不返回任何邮件（Items.Count = 0）
您的If条件永远不会满足（TypeName(myFolder.Items(i))永远不会"MailItem"）
您的默认邮箱已更改，并且不包含任何MailBox项目。
技术问题（即无法实例化Outlook实例，Office的其他版本等）

查找错误

要测试可能是哪个问题，建议您以 debug模式运行代码，并逐步执行每条指令（可以执行通过按 F8 ）。

在仍然执行代码的同时，检查变量的值（使用 Local Variable 窗口）。

这可以帮助您更好地了解代码的内容，并且对于查找问题出处有很大的帮助。

检查对象是否不为空

无论如何，在尝试访问该对象之前，最好先检查该对象是否已初始化。

为此，您可以添加以下说明：

If Not myItem Is Nothing then
    If myItem.UnRead = True Then
        'rest of your code...

希望这会有所帮助。

运行时错误91，代码在现在之前起作用了吗？

1 个答案:

查找错误

检查对象是否不为空