MS Access VBA EXCEL.EXE在.quit和=无后不终止

时间:2019-02-14 16:31:51

标签: excel vba ms-access

我正在运行打开用户提供的电子表格的代码。它只是引入了第一列(不包括标题)。运行代码一次按预期工作,除了它使EXCEL.EXE实例最后处于打开状态。我读过几个类似问题的问题,所有答案都围绕着找到未退出/关闭然后设置为空的任何对象。我对代码中的每个对象执行此操作,甚至进行错误检查,以检查是否未完成并退出并清除对象。在EXCEL.EXE无法关闭之后,第二次运行代码时,在.Cells(Rows.Count, 1).End(xlUp).Row上引发了“(1004)应用程序定义的错误或对象定义的错误”,有人知道这是为什么吗? 任何帮助将不胜感激

Private Sub SplitImports()
Dim StringVar As Variant
Dim strLn As String

'Asks user for Filepath
StringVar = InputBox("Please enter the file path for your list", "Import", "H:\FNMA_WFDC")

'Ends Function if no input or cancel is detected
MsgBox (StringVar)
If (StringVar = vbNullString) Then
    MsgBox ("No input, Please try again")
    Quittracker = True
    Exit Sub
End If

'Scrubs outer quotes if present
StringVar = Replace(StringVar, Chr(34), "", 1, 2)

'Creates the object to check the file
Dim FSO As Object
Set FSO = CreateObject("Scripting.Filesystemobject")
MsgBox ("Got Passed the FSO Object")

'Checks that our file exists, exits if not
If (Not FSO.FileExists(StringVar)) Then
    MsgBox ("File does not exist, try again")
    Quittracker = True
    Exit Sub
End If

Set FSO = Nothing

Dim xlApp As Object 'Excel.Application
Dim xlWrk As Workbook 'Excel.Workbook
Dim i As Long
Set xlApp = New Excel.Application
MsgBox ("Dimmed the excel objects")
xlApp.Visible = False

On Error GoTo ErrorTrap

Set xlWrk = xlApp.Workbooks.Open(StringVar) 'opens the excel file for processing
MsgBox ("objects are set")

With xlWrk.Worksheets("Sheet1")

    .Columns("A").NumberFormat = "@"
    MsgBox (.Cells(Rows.Count, 1).End(xlUp).Row)

    'walks through the excel sheet to the end and inserts the lines below the headerline into the database
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        DoCmd.RunSQL "Insert Into Split_List(Criteria) values('" & .Cells(i, 1).Text & "')"
    Next i

End With
MsgBox ("About to Clear and close the objects")

'closes the workbook and quits the application
xlWrk.Saved = True
xlWrk.Close
Set xlWrk = Nothing
xlApp.Quit
Set xlApp = Nothing

MsgBox ("End of the import sub")
Exit Sub

ErrorTrap:
    xlWrk.Saved = True
    xlWrk.Close
    Set xlWrk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    MsgBox ("(" & Err.Number & ") " & Err.Description    
    Quittracker = True
    Exit Sub

0 个答案:

没有答案