在Excel中使用输入字段在Access中查找和检索数据

Question

因此，我对编码非常陌生，我的工作让我深入到一个excel项目中，希望能够得到一些帮助。

我们目前拥有访问数据库，其中包含特定交易所上市证券的历史价格。我想知道是否可以使用VBA从Excel中提取选择输入的历史价格。到目前为止，我有这个代码 - 子getDataFromAccess（）

Dim DBFullName As String 
Dim Connect As String, Source As String 
Dim Connection As ADODB.Connection 
Dim Recordset As ADODB.Recordset 
Dim Col As Integer 
Dim Symbol As String 



' Database Path Info 
DBFullName = "O:\ProjectX\ProjectX.accdb" 

' Open the Connection 
Set Connection = New ADODB.Connection 
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;" 
Connect = Connect & "Data Source=" & DBFullName & ";" 
Connection.Open ConnectionString:=Connect 

' pull first symbol input from worksheet 
Symbol = ActiveSheet.Range("A1").Value 

' Create RecordSet 
Set Recordset = New ADODB.Recordset 
With Recordset 
' Filter Data 
Source = "SELECT * FROM HistoricalData WHERE [SYMBOL] = 'HYD'" 
' Source = "SELECT * FROM Customers WHERE [Job Title] = 'Owner' " 

.Open Source:=Source, ActiveConnection:=Connection 

' MsgBox "The Query:" & vbNewLine & vbNewLine & Source 


' Write field names 
For Col = 0 To Recordset.Fields.Count - 1 
Range("B1").Offset(0, Col).Value = Recordset.Fields(Col).Name 
Next 

' Write recordset 
Range("B1").Offset(1, 0).CopyFromRecordset Recordset 
End With 
ActiveSheet.Columns.AutoFit 
Set Recordset = Nothing 
Connection.Close 
Set Connection = Nothing 

End Sub 

正如你所看到的，它拉的HYD的数据，但我无法弄清楚如何把它取值，无论是从形式还是细胞。我曾尝试

Source = "SELECT * FROM HistoricalData WHERE [SYMBOL] = SYMBOL" 

和

Source = "SELECT * FROM HistoricalData WHERE [SYMBOL] = ActiveSheet.Range("A1)" 

Answer 1

你的表必须被索引这个工作。

'References set to: 
'Visual Basic for Applications 
'Microsoft Excel 12.0 Object Library 
'OLE Automation 
'Microsoft Office 12.0 Object Library 
'Microsoft Access 12.0 Object Library 
'Microsoft ActiveX Data Objects 6.0 Library 
'Microsoft ADO Ext. 6.0 for DDL and Security 

Sub CustomQuery() 
Dim cat As ADOX.Catalog 
Dim cmd As ADODB.Command 
Dim strPath As String 
Dim newStrSQL As String 
Dim oldStrSQL As String 
Dim strQryName As String 
Dim myArr() 
Dim objCell As Object 
Dim lstRow As Long 
lstRow = Cells(Rows.Count, "A").End(xlUp).Row 

ReDim myArr(0 To lstRow - 2) 
'lastrow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 

Dim j As Integer 
    j = 0 
    For Each objCell In Range("A2:A" & lstRow) 
    myArr(j) = objCell.Value 
    j = j + 1 
    Next objCell 

strPath = "C:\Users\your_path_here\Desktop\Vlookup.mdb" 

Dim i As Integer 
     newStrSQL = "SELECT Prices FROM Table1" _ 
     & " WHERE Table1.CUSIP IN (" 
     For i = 0 To UBound(myArr) 
     newStrSQL = newStrSQL & "'" & myArr(i) & "', " 
     Next i 
     ' trim off trailing comma and append closing paren 
     newStrSQL = Left(newStrSQL, Len(newStrSQL) - 2) & ")" 

    Set cat = New ADOX.Catalog 
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath 

    Set cmd = New ADODB.Command 
    'Set cmd = cat.Views(strQryName).Command 

    'oldStrSQL = cmd.CommandText 

    'Debug.Print oldStrSQL 

    'Method1 (Method2, below, needs to be commented out): 
    Worksheets(1).Range("B2").Select 
    While ActiveCell.Value <> "" 
     ActiveCell.Offset(1, 0).Select 
    Wend 
    ActiveCell.Value = newStrSQL 

    'Method2 (Method1, above, needs to be commented out): 
    'cmd.CommandText = newStrSQL 
    ''Debug.Print newStrSQL 
    'Dim s1 As Worksheet 
    'Set s1 = Sheets("Sheet1") 
    's1.Activate 
    'Set B2 = Range("B2") 
    'If IsEmpty(B2) Then 
     'i = 2 
     'Else 
     'i = Cells(Rows.Count, "B").End(xlUp).Row + 1 
    'End If 
    'Cells(i, "B").Value = newStrSQL 
    'Set cat.Views(strQryName).Command = cmd 

    Set cmd = Nothing 
    Set cat = Nothing 
End Sub