Question

我想将Access中的查询导入Excel电子表格。我希望代码可以调整sp在单元格B9中的工作表1上我可以键入Access中显示的查询名称。因此，只要我想导入一个新查询，我就必须在B9中更改名称。我当前的VBA硬编码查询的名称，我不知道如何更改它。这是我到目前为止导入列出的特定查询。

Sub GetQuery（）

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim i As Long
Dim wsh As Worksheet
Set dbs = DBEngine.OpenDatabase("C:\Desktop\DataProject\Database.accdb")
Set rst = dbs.OpenRecordset("Query One")
Set wsh = Worksheets("Sheet1")
For i = 0 To rst.Fields.Count - 1
    wsh.Cells(1, i + 1).Value = rst.Fields(i).Name
Next
wsh.Range("A1").Resize(ColumnSize:=rst.Fields.Count).Font.Bold = True
wsh.Range("A2").CopyFromRecordset rst
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing

End Sub

任何帮助将不胜感激！

Answer 1

嗯，不确定这是否真的有用，但也许你可以根据自己的需要进行调整：

Option Explicit
Dim ValueB9 As String

Private Sub Worksheet_Calculate()

If ThisWorkbook.Worksheets("Sheet1").Range("B9").Value = "" Or ThisWorkbook.Worksheets("Sheet1").Range("B9").Value = ValueB9 _
    Or Left(ThisWorkbook.Worksheets("Sheet1").Range("B9").Formula, 1) <> "=" Then
    Exit Sub
Else
    On Error GoTo ErrorHandle:
    ValueB9 = ThisWorkbook.Worksheets("Sheet1").Range("B9").Value
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim i As Long
    Dim wsh As Worksheet
    Set dbs = DBEngine.OpenDatabase("C:\Desktop\DataProject\Database.accdb")
    Set rst = dbs.OpenRecordset(ValueB9)
    Set wsh = Worksheets("Sheet1")
    For i = 0 To rst.Fields.Count - 1
        wsh.Cells(1, i + 1).Value = rst.Fields(i).Name
    Next
    wsh.Range("A1").Resize(ColumnSize:=rst.Fields.Count).Font.Bold = True
    wsh.Range("A2").CopyFromRecordset rst
    rst.Close
    Set rst = Nothing
    dbs.Close
    Set dbs = Nothing

End If

Exit Sub

ErrorHandle:
If Err.Number = 3078 Then
    MsgBox "Query name is wrong"
Else
    MsgBox Err.Description, vbCritical, "Error number " & Err.Number
End If
End Sub

每次在Sheet1的单元格B9中输入查询名称时，都会触发此代码。您必须在单元格中输入名称，如下所示：

="YOUR QUERY NAME"

如果不像公式那样输入（例如，如果只键入查询的名称），则不会触发。如果您输入错误的查询名称，则会抛出错误。

尝试根据您的需求进行调整。

根据可调整的输入将Access中的查询导入Excel

1 个答案: