Поиск базы данных Access в Excel

Question

Я хочу сделать что-то очень просто: у меня есть база данных Access с одной таблицей, отображающей тысячи идентификаторов продуктов в поля информации о продуктах. На листе Excel пользователь вводит, возможно, 100 идентификаторов продукта в первом столбце. Мне нужно, чтобы остальные столбцы извлекали информацию из базы данных Access для соответствующих идентификаторов. В частности:

1. Если я использую MS-Query, он, похоже, настаивает на том, что вывод является таблицей. Я просто хочу, чтобы выход находился внутри одной ячейки. Предпочтительно, формула, которая включает запрос типа SQL.
2. Я не хочу, чтобы какие-либо значения обновлялись автоматически, а скорее хотели бы, чтобы все столбцы обновлялись только по запросу пользователя (пользователь мог либо выбрать обновление через меню, либо кнопку обновления на основе VBA на листе хорошо также).

Я думаю, что это было бы простое использование, но, похоже, на удивление сложно найти решение. Заранее спасибо!

Answer 1

Работая в Excel, вы можете использовать ADO для подключения к базе данных. Для Access и Excel 2007/2010 вы можете:

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

Другая возможность возвращает одно поле из MS Access. В этом примере используется поздняя привязка, поэтому вам не нужна ссылка на библиотеку.

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 

Answer 2

ОК, это может показаться немного длительным - Создание Excel-таблица - в первой строке (из столбца два) у вас есть имена полей Точно так, как вы их в доступе-таблице, в первой колонке у вас есть требуемые значения ключа (например, CustomerID). При запуске макроса он заполняет в том, что он находит ...

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 

И если вы не хотите, чтобы ваши имена полей в листе первенствовать заменить пункт «Получить имена полей из Excelsheet» с этим:

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) 

и добавить в верхней

dim j as integer 
dim fieldnames