Access-database opzoeken in Excel

Ik wil iets heel eenvoudigs doen: ik heb een Access-database met één tabel die duizenden product-ID's in kaart brengt voor productinformatievelden. In een Excel-werkblad typt de gebruiker misschien 100 product-id's in de eerste kolom. Ik moet voor de resterende kolommen informatie uit de Access-database ophalen voor de overeenkomstige ID's. Concreet:

  1. als ik MS-Query gebruik, lijkt het erop te wijzen dat de uitvoer een tabel is. Ik wil gewoon dat de uitvoer zich in een enkele cel bevindt. Bij voorkeur een formule die een query van het SQL-type omvat.
  2. Ik wil niet dat een van de waarden automatisch wordt bijgewerkt, maar wil liever dat alle kolommen alleen op verzoek van de gebruiker worden bijgewerkt (de gebruiker kan kiezen voor vernieuwen via een menu of een vernieuwde VBA-knop op het werkblad is prima ook).

Ik denk dat dit een eenvoudige use-case zou zijn, maar het lijkt verrassend moeilijk om een ​​oplossing te vinden. Dank u bij voorbaat!

1
Heb je geprobeerd MS-Query in een VBA te gebruiken en het vervolgens te manipuleren voordat het naar een enkele cel werd uitgevoerd?
toegevoegd de auteur Fluffeh, de bron
Werkend vanuit het Excel-einde heb je behoorlijk wat VBA en wat ADO nodig. Vanaf het Access-einde kunt u eenvoudig het werkblad als een tabel koppelen en het queryontwerpvenster gebruiken om query's uit te voeren. De query kan worden uitgevoerd naar een nieuw Excel-blad.
toegevoegd de auteur Fionnuala, de bron
Ik ken VBA niet, maar kan leren indien nodig. Maar ik hoopte dat dit eenvoudig genoeg is om echt eenvoudig te zijn, en geen VBA nodig te hebben of slechts minimale VBA nodig hebben.
toegevoegd de auteur PonyEars, de bron
Ik ben alleen geïnteresseerd in het doen van dit vanaf het einde van Excel. Is er ergens een voorbeeld of documentatie die ik zou kunnen volgen?
toegevoegd de auteur PonyEars, de bron

2 antwoord

Als u vanuit Excel werkt, kunt u ADO gebruiken om verbinding te maken met een database. Voor Access en Excel 2007/2010 kunt u:

''Reference: Microsoft ActiveX Data Objects x.x Library
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

''Not the best way to refer to a workbook, but convenient for 
''testing. it is probably best to refer to the workbook by name.
strFile = ActiveWorkbook.FullName

''Connection string for 2007/2010
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 12.0 xml;HDR=Yes;"";"

cn.Open strCon

''In-line connection string for MS Access 
scn = "[;DATABASE=Z:\Docs\Test.accdb]"
''SQL query string
sSQL = "SELECT a.Stuff, b.ID, b.AText FROM [Sheet5$] a " _
& "INNER JOIN " & scn & ".table1 b " _
& "ON a.Stuff = b.AText"
rs.Open sSQL, cn

''Write returned recordset to a worksheet
ActiveWorkbook.Sheets("Sheet7").Cells(1, 1).CopyFromRecordset rs

Een andere mogelijkheid retourneert een enkel veld vanuit MS Access. In dit voorbeeld wordt late binding gebruikt, dus u hebt geen bibliotheekverwijzing nodig.

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

strFile = "z:\docs\test.accdb"

strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")


cn.Open strCon

''Select a field based on a numeric reference
strSQL = "SELECT AText " _
       & "FROM Table1 a " _
       & "WHERE ID = " & Sheets("Sheet7").[A1]

rs.Open strSQL, cn, 3, 3

Sheets("Sheet7").[B1] = rs!AText
2
toegevoegd
Geweldig bedankt. Dit was meer betrokken dan ik had verwacht, dus je voorbeeldcode was erg handig om me te helpen dit op te zetten.
toegevoegd de auteur PonyEars, de bron
Tussen haakjes, voor iedereen die naar deze code kijkt: het kostte me een tijdje om op te merken dat het eerste voorbeeld een Excel-spreadsheet (hetzelfde bestand) gebruikt als de backend-database, terwijl het tweede voorbeeld een Access-database-backend gebruikt. Handig om te weten dat beide mogelijkheden zijn.
toegevoegd de auteur PonyEars, de bron

OK, dit lijkt misschien een beetje lang - Maak een Excel-tabel - in de eerste rij (van kolom twee) heb je de veldnamen Precies zoals je ze in de toegangstabel hebt, in de eerste kolom heb je de gewenste sleutel/waarden (bijvoorbeeld CustomerIDs). Wanneer u de macro uitvoert, vult deze in wat het vindt ...

Sub RefreshData()
  Const fldNameCol = 2 'the column with the first fieldname in it'
  Dim db, rst As Object

  Set db = DBEngine.workspaces(0).OpenDatabase("C:\path\to\db\name.accdb")
  Set rst = db.openrecordset("myDBTable", dbOpenDynaset)

  Dim rng As Range
  Dim showfields() As Integer
  Dim i, aRow, aCol As Integer

  ReDim showfields(100)
  Set rng = Me.Cells

  aRow = 1 'if you have the fieldnames in the first row'
  aCol = fldNameCol

  '***** remove both '' to speed things up'
  'On Error GoTo ExitRefreshData'
  'Application.ScreenUpdating = False'

  '***** Get Fieldnames from Excel Sheet'
  Do
    For i = 0 To rst.fields.Count - 1
      If rst.fields(i).Name = rng(aRow, aCol).Value Then
        showfields(aCol) = i + 1
        Exit For
      End If
    Next
    aCol = aCol + 1
  Loop Until IsEmpty(rng(aRow, aCol).Value)
  ReDim Preserve showfields(aCol - 1)


  '**** Get Data From Databasetable'
  aRow = 2 'startin in the second row'
  aCol = 1 'key values (ID) are in the first column of the excel sheet'
  Do
    rst.FindFirst "ID =" & CStr(rng(aRow, aCol).Value) 'Replace ID with the name of the key field'
    If Not rst.NoMatch Then
      For i = fldNameCol To UBound(showfields)
        If showfields(i) > 0 Then
          rng(aRow, i).Value = rst.fields(showfields(i) - 1).Value
        End If
      Next
    End If
    aRow = aRow + 1
  Loop Until IsEmpty(rng(aRow, aCol).Value)

ExitRefreshData:
  Application.ScreenUpdating = True
  On Error GoTo 0
End Sub

En als u niet wilt dat uw veldnamen in het Excel-blad de paragraaf "Get Fieldnames From Excelsheet" vervangen door dit:

  fieldnames = Split("field1name", "", "", "field3name")
  For j = 0 To UBound(fieldnames) - 1
    For i = 0 To rst.fields.Count - 1
      If rst.fields(i).Name = fieldnames(j) Then
        showfields(j + fldNameCol) = i + 1
        Exit For
      End If
    Next
  Next
  ReDim Preserve showfields(UBound(fieldnames) - 1 + fldNameCol)

en voeg dit bovenaan toe

dim j as integer
dim fieldnames
1
toegevoegd
Hoe bedoel je repliceren? De code benadert de database en haalt alle gewenste informatie (en alleen dat) eruit en plaatst deze in de Excel-tabel. De recordset blijft niet bestaan ​​in de Excel-tabel. Remous code is echter veel mooier in zijn eenvoud.
toegevoegd de auteur Johanness, de bron
Ik repliceer de databasegegevens liever niet in Excel, maar je code toonde me andere waardevolle dingen, dus bedankt!
toegevoegd de auteur PonyEars, de bron