间歇性访问错误 3420 "Object invalid or no longer set."

Intermittent Access error 3420 "Object invalid or no longer set."

任何人都可以告诉我我的代码哪里有问题它工作 10 次 3 次,问题在哪里 导入一个 Excel 文件并在插入新行后删除第一行和第二行并编辑行中和输入框之后的名称,但我认为问题出在这里

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "ps", imyDateiname, True

Private Sub Command50_Click()

 DoCmd.SetWarnings False
    Const msoFileDialogFilePicker As Long = 1
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Dim selectedFilter As String
    Dim imyDateiname As String
    With fDialog
        .AllowMultiSelect = False
        .Filters.Clear
                .Filters.Add "Excel", "*.xlsx", 1
        .Show
        If .SelectedItems.Count = 0 Then
            imyDateiname = ""
        Else
            imyDateiname = Dir(.SelectedItems(1))
        End If
        selectedFilter = .FilterIndex
    End With
    If imyDateiname <> "" Then
        Dim oExc As New Excel.Application

        With oExc    
            .Workbooks.Open "C:\Users\" & Environ("UserName") _ 
                                 & "\Desktop\" & imyDateiname

            .Rows("1:2").Delete
            .Rows("1:2").EntireRow.Insert
            .Worksheets("ps").Columns("B").Replace _
                   What:="-", Replacement:=" ", _
                   SearchOrder:=xlByColumns, MatchCase:=True
        End With

        With oExc
              Cells(1, 1).Value2 = "Ebene"
              Cells(1, 2).Value2 = "OrgEinheit"
              Cells(1, 3).Value2 = "Titel"
              Cells(1, 4).Value2 = "PersNr"
              Cells(1, 5).Value2 = "Geburtsdatum"
              Cells(1, 6).Value2 = "Eintrittsdatum"
              Cells(1, 7).Value2 = "Befristungs"
              Cells(1, 8).Value2 = "Beginnalter"
              Cells(1, 9).Value2 = "Beginnfrei"
              Cells(1, 10).Value2 = "WK2"
              Cells(1, 11).Value2 = "WT"
              Cells(1, 12).Value2 = "Kostenstelle"
              Cells(1, 13).Value2 = "Schlüssel"
              Cells(1, 14).Value2 = "Tätigkeitsbezeichnung"
              Cells(1, 15).Value2 = "IRWAZ"
              Cells(1, 16).Value2 = "IstAK"
              Cells(1, 17).Value2 = "BelGrp"

            .ActiveWorkbook.SaveAs "C:\Users\" & Environ("UserName") _
                      & "\Desktop\" & imyDateiname
            .Quit
        End With   

        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
              "ps", imyDateiname, True

        Dim str As String
        str = InputBox("INSERT THE NUMBER OF THE MONTH PLEASE")
        execQry "upd_TPS_Monat", str
        Me.Refresh
        MsgBox "DONE YOUR DATA ARE READY!"
   End If
End Sub**

您应该首先 Close/Quit Excel 对象,然后将其设置为空

Set oExc = Nothing

请参阅this Post by Bob Larson

Excel 对象可能仍保留文件,将对象设置为 Nothing 可增强垃圾收集, 释放文件,并允许 Access 导入其内容。 编辑:请参阅this reference about Garbage collecting in VBA

如果不出意外,这行代码将添加一些纳秒,并且让 import 运行 没有错误。