excel - 试图通过访问 vba 从 xls 文件中读取某些单元格。依赖 Excel 的问题

问题描述

我的任务是在我们存储部件列表的 microsoft 访问中创建一个数据库。列表以 excel 格式 .xls 交付。此工作表有一个字段标题字段（带有数据的不同单元格）和下面几行的列表。如果当前有一个正常打开的 excel 文件，例如您的个人.XLSB，我可以让代码工作。如果 Excel 没有运行，我会遇到以下问题

:error 429.activeX 无法创建对象。

或者有时在 VBA 中出现错误 462：

找不到远程服务器机器，

应用程序开始于：Cmd_Inlezen_Stuklijst_Import_Click

我试图通过测试excel是否正在运行函数IsExcelRunning来创建在后台运行的excel实例

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 错误

我检查excel状态后if语句中的代码也是根据示例。（我不再知道来源）

我打开了 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是否正在运行，我都需要以某种方式捕捉方法的差异。

标签： excelvbams-access

excel - 试图通过访问 vba 从 xls 文件中读取某些单元格。依赖 Excel 的问题

问题描述

解决方案

推荐阅读