為什么通過Access數據庫中的VBA打開和關閉多個Excel工作簿時偶爾會出現錯誤91

Question

我從客戶那里收到各種電子表格。 我想重命名源文件，以將客戶端創建文件的日期包含到文件名中。 我閱讀了文件名列表，並將其存儲在Access表中。 我閱讀了表格，並為列出的每個文件打開了excel，以便可以獲取電子表格的內置文檔屬性，然后嘗試重命名該文件。

該代碼有效，但是在某些情況下，我在嘗試檢索excel文件的“創建日期”的行上收到錯誤91。 我無法確定發生這種情況的具體原因。 有時它可以通過文件的完整列表起作用，有時則不能。 有時只有1個文件時出現錯誤91。 有時它可以通過5到10的列表正常運行。文件位於網絡共享上，我的直覺是也許代碼正在嘗試將屬性完全加載到Excel中之前訪問該屬性。 那可能嗎？ 我嘗試創建人為的暫停。 問題仍然存在。 我試着實際上使電子表格處於活動狀態，即使我認為我不必這樣做。 我已關閉更新和警報。 到目前為止，這都不重要。 最初從文件腳本開始，而不是打開excel文件。 但是創建日期的fso屬性看起來像在文件系統上創建文件的日期，而不是客戶端創建電子表格的日期。

Private Sub RenameImportFiles()
'On Error GoTo ErrorHandler
    Dim dbMedent As Database
    Dim oFS As Object
    Dim strFileParts() As String
    Dim strDateParts() As String
    Dim strDayParts() As String
    Dim strTimeParts() As String

    Dim strCreation As String

    Dim strSQL As String
    Dim rsRead As Recordset
    Dim strFileName As String
    Dim strFileNameNew As String

    Dim intTime As Integer
    Dim intRecExpect As Integer
    Dim intRecCurr As Integer
    Dim intRecComp As Integer

    Me.txtProcWindow = "Renaming Import Files ..."

    intRecExpect = 0
    intRecCurr = 0
    intRecComp = 0


    'This creates an instance of the MS Scripting Runtime FileSystemObject class
    Set oFS = CreateObject("Scripting.FileSystemObject")

    strSQL = "SELECT * FROM Files_In_Folders ORDER BY FileName"
    Set dbMedent = CurrentDb
    Set rsRead = dbMedent.OpenRecordset(strSQL)
    intRecExpect = rsRead.RecordCount
    Me.txtFileCnt_Expect = intRecExpect

    With rsRead
        .MoveLast
        .MoveFirst
        If .RecordCount < 1 Then
            '/*****************   ERROR HANDLING ****************
        End If


        Dim xlApp As Excel.Application
        Set xlApp = CreateObject("Excel.Application")


        While Not .EOF
            intRecCurr = intRecCurr + 1
            Me.txtFileCnt_Current = intRecCurr
            Me.txt_Curr_FileNm = strFileName
            Me.txtCurr_FileID = rsRead![FileID]

            strFileName = ![FilePath] & ![FileName]

            xlApp.ScreenUpdating = False
            xlApp.DisplayAlerts = False
            xlApp.EnableEvents = False
            xlApp.Visible = False

            xlApp.Workbooks.Open FileName:=strFileName
            'for debugging errror #91 pops up occasionally;  why does it sometimes think property doesn't exist
            'force excel to activate a sheet, then get property;  or force excel to wait a few seconds???
            Call WaitFor(1)
            xlApp.Worksheets(1).Activate

            'MsgBox "trying to open:  " & strFileName

            ***strCreation = ActiveWorkbook.BuiltinDocumentProperties("Creation Date")***
            strFileParts = Split(strCreation)
            strDayParts = Split(strFileParts(0), "/")
            strTimeParts = Split(strFileParts(1), ":")
            If strFileParts(2) = "PM" Then
                intTime = CInt(strTimeParts(0)) + 12
            Else
                intTime = CInt(strTimeParts(0))
            End If
            strFileNameNew = ![FilePath] & ![FilePracticeTIN] & "_" & _
                            strDayParts(2) & Format(strDayParts(0), "00") & Format(strDayParts(1), "00") & _
                            Format(intTime, "00") & Format(strTimeParts(1), "00") & Format(strTimeParts(2), "00") & _
                            "_" & ![FileMeas] & ![FileType]
            ActiveWorkbook.Close SaveChanges:=False
            oFS.CopyFile strFileName, strFileNameNew, True

            rsRead.Edit
            ![FileName] = ![FilePracticeTIN] & "_" & _
                            strDayParts(2) & Format(strDayParts(0), "00") & Format(strDayParts(1), "00") & _
                            Format(intTime, "00") & Format(strTimeParts(1), "00") & Format(strTimeParts(2), "00") & _
                            "_" & ![FileMeas] & ![FileType]
            ![FileRptDate] = strDayParts(2) & Format(strDayParts(0), "00") & Format(strDayParts(1), "00")
            ![FileRptTime] = Format(intTime, "00") & Format(strTimeParts(1), "00") & Format(strTimeParts(2), "00")

            rsRead.Update
            intRecComp = intRecComp + 1
            Me.txtFileCnt_Good = intRecComp
            Me.txtFileCnt_Bad = intRecExpect - intRecComp
            Me.txt_Curr_FileNm = strFileName
            DoEvents
            rsRead.MoveNext
        Wend
    End With

    xlApp.ScreenUpdating = True
    xlApp.DisplayAlerts = True
    xlApp.EnableEvents = True

    xlApp.Quit


RenameImportFiles_Exit:
    xlApp.Quit
    Set dbMedent = Nothing
    Set oFS = Nothing
    Me.txtProcWindow = Me.txtProcWindow & vbCrLf & SPACE8 & "Expected " & intRecExpect & " files." & _
                        vbCrLf & SPACE8 & "Renamed " & intRecComp & " files." & _
                        vbCrLf & SPACE8 & (intRecExpect - intRecComp) & " files had Errors or other issues." & _
                        vbCrLf & SMALL_DONE

    Call HideProgressBar(True)
    Exit Sub

ErrorHandler:
    MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
    Resume RenameImportFiles_Exit
End Sub

錯誤91並非總是會發生。 1個文件重命名或多個文件時可能會發生。 這不是我能告訴的任何特定間隔。 例如，要處理5個文件。 第一遍，它重命名2個文件，然后在文件3上出現錯誤91。20分鍾后，我再試一次，所有5個問題都得到處理。 10分鍾后，我再試一次，並且在第一個文件上出現錯誤91。 如果我msgbox文件名，它似乎每次都能工作。 但是當此流程移至生產階段時，這是不可行的選擇，因為我們希望一次處理30至40個文件，每天2至3個客戶。

Answer 1

  Dim xlApp As Excel.Application Set xlApp = CreateObject("Excel.Application") 

您早已束手無策，無需使用CreateObject來訪問注冊表即可保留Excel.Application類型。 只需New起來，編譯器已經知道在哪里可以找到它：

Set xlApp = New Excel.Application

您將在此處丟棄返回的Workbook對象：

  xlApp.Workbooks.Open FileName:=strFileName 

捕獲它：

Dim xlBook As Workbook
Set xlBook = xlApp.Workbooks.Open(strFileName)

這是個問題：

 strCreation = ActiveWorkbook.BuiltinDocumentProperties("Creation Date") 

不合格， ActiveWorkbook隱式地創建了一個沒有引用的Excel.Global / Excel.Application對象：該對象不是您的xlApp它是隱式創建的隱式幽靈實例，並且沒有活動的工作簿，這將解釋錯誤91。資格成員調用：

strCreation = xlApp.ActiveWorkbook.BuiltinDocumentProperties("Creation Date")

但是實際上，如果您捕獲了工作簿變量，那么您將不在乎活動工作簿是什么：

strCreation = xlBook.BuiltinDocumentProperties("Creation Date")

同樣在這里：

 ActiveWorkbook.Close SaveChanges:=False 

轉至：

xlBook.Close SaveChanges:=False

關閉Access后，任務管理器中可能存在許多“幽靈” EXCEL.EXE進程：這種情況下，您必須手動殺死這些進程。

---

這也是潛在的問題：

  xlApp.Quit RenameImportFiles_Exit: xlApp.Quit 

如果While...Wend循環（應該是Do While...Loop ）運行完成，則xlApp.Quit將運行兩次...那是不對的。

---

 'for debugging errror #91 pops up occasionally; why does it sometimes think property doesn't exist 

錯誤91並不意味着“屬性不存在”，那就是錯誤438。錯誤91意味着“ 對象不存在”，例如，您要調用foo.Bar ，但是foo是Nothing 。