间歇性访问错误3420"对象无效或不再设置。"

时间:2016-03-18 08:50:41

标签: vba ms-access access-vba ms-office

任何人都可以告诉我,我的代码问题在哪里它从10次工作3次,问题在哪里 procces导入一个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**

1 个答案:

答案 0 :(得分:0)

您应首先关闭/退出Excel对象,然后将其设置为空

Set oExc = Nothing

请参阅this Post by Bob Larson

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

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