为什么通过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 。