在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