我正在运行打开用户提供的电子表格的代码。它只是引入了第一列(不包括标题)。运行代码一次按预期工作,除了它使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