Попытка прочитать определенные ячейки из файла XLS через доступ VBA.Проблема с зависимостью от Excel

Question

Мне поручено создать базу данных в Microsoft Access, к которой мы храним список деталей.Списки доставляются в формате Excel .xls.Эта рабочая таблица имеет поля заголовка поля (отдельные ячейки с данными) и список несколькими строками ниже.Я могу заставить код работать, ЕСЛИ в настоящее время есть нормально открытый файл Excel, например, ваш personal.XLSB.Если Excel не работает, я получаю проблемы в виде

: ошибка 429. ActiveX не может создать объект.

или время от времени ошибка 462 в VBA:

компьютер удаленного сервера не найден,

приложение запускается с: Cmd_Inlezen_Stuklijst_Import_Click

Я попытался создать экземпляр Excel, работающий в фоновом режимепутем тестирования, если Excel запускает функцию IsExcelRunning

Application.ScreenUpdating = False
Dim src As Workbook

' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
Set src = Workbooks.Open(Me!TxtFullPath)

src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing

, иногда это кажется работающим, но я не смог точно определить, как.

Я буквально скопировал https://social.msdn.microsoft.com/Forums/en-US/ffd5975b-83fa-4d64-94af-7230f0058a3d/opening-an-excel-file-from-ms-access?forum=isvvba

затем изменил путь к нужному файлу, но пока Excel не работает, он не работает.

вместо CreateObject, я также пытался GetObject, но та же ошибка 429

Код в операторе if после проверки статуса Excel также соответствует примеру.(источник мне больше не известен)

У меня есть ссылки на библиотеку объектов Microsoft Excel 14.

'***************************************************************************
'Purpose: check if excel is running  0 als onwaar    -1 als waar
'Inputs
'Outputs: boolean
'***************************************************************************
Public Function IsExcelRunning() As Boolean '
    Dim xl As Object

    On Error Resume Next

    Set xl = GetObject(, "Excel.Application")
    IsExcelRunning = (Err.Number = 0)

    Set xl = Nothing
End Function

'***************************************************************************
'Purpose: pikt de kop gegevens van het formulier op.
'Inputs:
'A2 leeg
'B2 stuklijstNaam
'C2 editie klant
'D2 Editie Debrug
'E2 Stuklijstomschrijving
'F2 creatiedatum
'G2 ontvangstdatum
'H2 werktijd
'I2 Default aantal
'J2 klant naam
'B3 eindproduct
'B3 eindproduct omschrijving
'Outputs: boolean
'***************************************************************************
Function MiscDataFetch() As Boolean                    'leest headers
    Dim my_xl_app As Object
    Dim my_xl_worksheet As Object
    Dim my_xl_workbook As Object
    Set my_xl_app = CreateObject("Excel.Application")
    my_xl_app.UserControl = True
    my_xl_app.Visible = False    ' yes. I know it's the default
    'WasteTime (2)
    Set my_xl_workbook = GetObject(Me!TxtFullPath)
    'Set my_xl_workbook = CreateObject(Me!TxtFullPath)
    Set my_xl_worksheet = my_xl_workbook.Worksheets(1)

    Me!FilStuklijstNaam = my_xl_worksheet.Cells(2, "B")
    Me!FilEditieKlant = my_xl_worksheet.Cells(2, "C")
    Me!FilEditieDeBrug = my_xl_worksheet.Cells(2, "D")
    Me!FilStuklijstOmschrijving = my_xl_worksheet.Cells(2, "E")
    Me!FilCreatieDatum = my_xl_worksheet.Cells(2, "F")
    Me!FilOntvangstDatum = my_xl_worksheet.Cells(2, "G")
    Me!FilWerktijd = my_xl_worksheet.Cells(2, "H")
    Me!filDefaultAantal = my_xl_worksheet.Cells(2, "I")
    Me!FilKlantNaam = my_xl_worksheet.Cells(2, "J")
    Me!FilEindpoduct = my_xl_worksheet.Cells(3, "B")
    Me!FilEindproductOmschr = my_xl_worksheet.Cells(3, "E")

    my_xl_workbook.Close SaveChanges:=False
    Set my_xl_app = Nothing
    Set my_xl_workbook = Nothing
    Set my_xl_worksheet = Nothing

    MiscDataFetch = True
End Function

Sub WasteTime(Finish As Long)
    Dim NowTick As Long
    Dim EndTick As Long

    EndTick = GetTickCount + (Finish * 1000)

    Do
        NowTick = GetTickCount

        GetTickCount = GetTickCount + (1)
    Loop Until NowTick >= EndTick
End Sub

'***************************************************************************
'Purpose: controleert de kopgegevens
'Inputs
'Outputs: boolean   True: alle gegevens voorzien
'                   False: er zijn velden nieet ingevuld
'***************************************************************************
Function FullMiscDataFetch() As Boolean
    FullMiscDataFetch = True
    Dim Fullfilled As Integer
    If Me!FilStuklijstNaam = "" Then Fullfilled = Fullfilled + 1
    If Me!FilEditieKlant = "" Then Fullfilled = Fullfilled + 1
    If Me!FilEditieDeBrug = "" Then Fullfilled = Fullfilled + 1
    If Me!FilStuklijstOmschrijving = "" Then Fullfilled = Fullfilled + 1
    If Me!FilCreatieDatum = "" Then Fullfilled = Fullfilled + 1
    If Me!FilOntvangstDatum = "" Then Fullfilled = Fullfilled + 1
    If Me!FilWerktijd = "" Then Fullfilled = Fullfilled + 1
    If Me!filDefaultAantal = "" Then Fullfilled = Fullfilled + 1
    If Me!FilKlantNaam = "" Then Fullfilled = Fullfilled + 1
    If Me!FilEindpoduct = "" Then Fullfilled = Fullfilled + 1
    If Me!FilEindproductOmschr = "" Then Fullfilled = Fullfilled + 1

    If Fullfilled > 1 Then
        MsgBox "Niet alle detailvelden bevatten gegevens." & vbCrLf & "Vul de gegevens aan en probeer opnieuw."
        FullMiscDataFetch = False
    End If
End Function

'***************************************************************************
'Purpose: inleescommando voor deze pagina (Frm_stuklijst_Import).
'Inputs
'Outputs:
'***************************************************************************
Private Sub Cmd_Inlezen_Stuklijst_Import_Click()        'commando voor lijst MET headers
    Dim SQLKlantUpdate As String
    Dim SQLKlantIDUpdate As String
    'DoCmd.RunSQL "DELETE * FROM Tbl_Stuklijst_Import"   'opschonen werkblad
    'opschonen
    'SubFrm_Tbl_Stuklijst_Import.Requery                 'updaten van visueel gegeven lege lijst

    If IsExcelRunning Then
    Else
        'Application.ScreenUpdating = False
        'Dim src As Workbook

        ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
        'Set src = Workbooks.Open(Me!TxtFullPath)

        'src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
        'Set src = Nothing
    End If

    MiscDataFetch       'get header comments
    'FetchData           'get material list
    FullMiscDataFetch   'controle of alle velden info bevatten
End Sub

Ожидаемый результат заключается в том, что отдельные ячейки читаются и переносятся в поля вформа, независимо от того, работает Excel или нет, и пользователю не нужно вмешиваться, активируя Excel, чтобы обойти ошибку.Мне нужно как-то уловить разницу в методе, работает Excel или нет.

Answer 1

Если вы используете типы Excel, как в

Dim wb As Excel.Workbook

тогда у вас должна быть ссылка на Excel; однако, если вы работаете с Late Binding , как в

Dim wb As Object 'Excel.Workbook

Затем удалите ссылку на Excel. Преимущество в том, что ваш код будет работать с разными версиями Excel. В противном случае вы привязаны к определенной версии. Часто я использую раннее связывание (первый метод) во время разработки, а затем переключаюсь на Object для всех типов библиотек и удаляю ссылку. Это делает приложение Access более стабильным.

Обычно я использую этот код для получения приложения. Если приложение открыто, я возвращаю его (GetObject), в противном случае я создаю его (CreateObject). Здесь показано с Word:

Public Function GetWordApplication() As Object
    'Gets an active Word application or opens a new Word instance.
    'Raises Error No. 8 if word cannot be opened.

    On Error Resume Next
    'Find existing instance of Word
    Set GetWordApplication = GetObject(, "Word.Application")
    If Err.Number <> 0 Then 'Not found, create new instance.
        Set GetWordApplication = CreateObject("Word.Application")
    End If
    On Error GoTo 0
    If GetWordApplication Is Nothing Then
        Err.Raise 8, "YourApp.GetWordApplication", "Word could not be opened."
    End If
End Function

Answer 2

Попробуйте открыть и закрыть файл Excel:

Dim xl As Excel.Application
Dim xlBook As Excel.workbook
Dim xlSheet As Excel.worksheet
Set xl = New Excel.Application
Set xlBook = xl.Workbooks.Open(Filename)
Set xlSheet = xlBook.Worksheets(1)

…

xlBook.Close
Set xlSheet = Nothing
Set xlBook = Nothing
Set xl = Nothing