Trying to read certain cells from an xls file through access vba. Trouble with dependency on Excel

Question

I am tasked with making a database in microsoft access to which we store parts list. The lists gets delivered in the excel format .xls. This worksheet has a field header fields ( distinct cells with data) and a list a few rows below. I can get the code to work IF currently there is a normally opened excel file, for instance your personal.XLSB. If Excel is not running, i get issues in the form of

:error 429. activeX can not create object.

or at times an Error 462 in VBA :

remote server machine not found,

application starts with: Cmd_Inlezen_Stuklijst_Import_Click

i have tried to create an instance of excel running in the background by testing if excel is running the function 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

sometimes this seems toworks, but i haven't been able to determine exactly how.

i LITERALLY copied https://social.msdn.microsoft.com/Forums/en-US/ffd5975b-83fa-4d64-94af-7230f0058a3d/opening-an-excel-file-from-ms-access?forum=isvvba

then changed the path to the file i need, but as long as excel is NOT running, it doesn't work.

instead of CreateObject, I also tried GetObject but same 429 error

The code in the if statement after i check the status of excel is also according to example. ( source no longer known to me)

I have the references turned on Microsoft Excel 14 object library.

'***************************************************************************
'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

expected result is that the distinct cells are read and transferred to fields in the form, whether excel is running or not, and without the need for the user to intervene by activating Excel to bypass the error. I need to somehow catch the difference in method whether excel is running or not.

score 0 · Answer 1 · answered May 02 '19 at 14:26

Try this to open and close an Excel file:

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

Olivier Jacot-Descombes · Answer 2 · 2019-05-02T14:34:00.300

If you are using types of Excel as in

Dim wb As Excel.Workbook

then you must have a reference to Excel; however, if you are working with Late Binding as in

Dim wb As Object 'Excel.Workbook

Then remove the reference to Excel. This has the advantage that your code will work with different versions of Excel. Otherwise you are tied to a specific version. Often I use early binding (first method) during development and then switch to Object for all library-specific types and remove the reference. This makes the Access application more stable.

I usually use this code to get the application. If the application is open I return it (GetObject), otherwise I create it (CreateObject). Here shown with 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

Trying to read certain cells from an xls file through access vba. Trouble with dependency on Excel

2 Answers2