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

Question

所以我对编码很陌生，我的工作让我潜入一个excel项目，并希望我能得到一些帮助。

我们目前拥有一个访问数据库，其中包含某些交易所上市证券的历史价格。我想知道VBA是否有可能从excel中提取选择输入的历史价格。到目前为止我有这个代码 -     Sub 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