Excelで入力フィールドを使用して、アクセス時にデータを検索して取得する

Question

私はコーディングに新しい経験があり、私の仕事は私にExcelプロジェクトに参加してくれていて、助けてもらいたいと思っていました。

現在、特定の取引所に上場されている有価証券の過去の価格のアクセスデータベースがあります。私はVBAで、選択された入力の過去の価格を引き出すことが可能かどうか疑問に思っていました。これまでのところ、私はあなたが見ることができるように、これは サブ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