在 for 循环的第二次迭代中发生对象变量或块变量未设置错误

Question

我在 Outlook 中使用以下代码从电子邮件列表中下载附件。

代码在循环的第一次迭代中运行良好，但在第二次迭代中，它在尝试将文件保存到桌面上的临时文件夹的步骤中出现 Run-time error '91' Object variable or With block variable not set 错误（即行 @987654323 @)。

通过阅读文档here 和一些测试，似乎问题实际上是由wb.close 在循环的第一次迭代中引起的，这将wb 设置为空，然后导致错误第二次迭代。

如果我是对的，那么我的问题是如何“重新指定对象变量的引用”？

Sub SaveExcels()

Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Dim Item As Object
Dim objAttachments As Outlook.Attachments

For Each Item In olFolder.Items

    If TypeOf Item Is Outlook.MailItem Then

        Dim oMail As Outlook.MailItem: Set oMail = Item

        ' Check it contains an attachment
        Set objAttachments = oMail.Attachments
        lngCount = objAttachments.Count

        ' Check its from the right company
        senderCheck = InStr(oMail.SenderEmailAddress, "company.com")

        ' Check that it is the right email type
        subjectCheck = InStr(oMail.Subject, "TYPE")

        ' Check whether its the latest weeks data
        receivedDate = DateValue(oMail.ReceivedTime)
        todaysDate = DateValue(Now())
        dateDifference = todaysDate - receivedDate

        If lngCount > 0 And senderCheck > 0 And subjectCheck > 0 And dateDifference <= 7 Then

            ' Get the file name
            strFile = objAttachments.Item(1).FileName
            ' Debug.Print strFile

            strFolderpath = "D:\Users\" & Environ("Username") & "\Desktop\temp\"

            ' Combine with the path to the Temp folder.
            strFileIncPath = strFolderpath & strFile
            ' Debug.Print strFile

            ' Save the attachment as a file.
            objAttachments.Item(1).SaveAsFile strFileIncPath

            ' Extract the files into the newly created folder
            Set oApp = CreateObject("Shell.Application")
            oApp.NameSpace(strFolderpath).CopyHere oApp.NameSpace(strFileIncPath).Items

            ' Delete the zip file
            Kill strFileIncPath

            ' Open the excel file
            Dim xlApp As Object
            Set xlApp = CreateObject("Excel.Application")

            xlApp.Application.Visible = True
            xlName = Replace(strFile, ".ZIP", "")
            xlNameTemp = xlName & "_00000.xls"
            xlNameAndPath = strFolderpath & xlName
            Debug.Print xlNameAndPath

            xlApp.Workbooks.Open strFolderpath & xlNameTemp

            Dim wb As Workbook
            Set wb = ActiveWorkbook

            ' Save as unique name and close
            wb.SaveAs FileFormat:=51, FileName:=xlNameAndPath << ERROR

            ' Get rid of the old excel
            Kill strFolderpath & xlNameTemp

            ' Close the workbook
            wb.Close

        End If

    End If

Next

End Sub

Answer 1

我相信

Dim wb As Workbook
Set wb = xlApp.Workbooks.Open(strFolderpath & xlNameTemp)

将按照the docs 完成这项工作。 （未测试 -YMMV！）