MS Access VBA EXCEL.EXE не завершается после .quit и = ничего - PullRequest
0 голосов
/ 14 февраля 2019

Я запускаю код, который открывает предоставленную пользователем электронную таблицу.Он просто вводит первый столбец, исключая заголовок.запуск кода один раз работает, как и ожидалось, за исключением того, что он оставляет экземпляр EXCEL.EXE открытым в конце.Я прочитал несколько вопросов, имеющих эту похожую проблему, все ответы окружают нахождение любого объекта, который не был закрыт / закрыт, а затем установлен в ноль.Я делаю это для каждого объекта в моем коде и даже провожу проверку ошибок, которая перехватывает, если он не завершается, и завершает работу и очищает объекты.При втором запуске кода после того, как EXCEL.EXE не закрывается, он выдает «(1004) Ошибка приложения или объекта» на .Cells(Rows.Count, 1).End(xlUp).Row Кто-нибудь знает, почему это так?любая помощь будет оценена

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...