Question

我正在尝试使用vba编写访问excel的查询/表格内容。目前我的代码正在努力每次打开新工作簿并编写内容而我需要指定只写一个工作簿的路径。如何在代码中指定路径

我的访问VBA

Function WriteToExcel()
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strPath As String
Dim ws As Excel.Application
Dim i As Long
'*************************************************
'First stage is to take the first query and place it
'On sheet1
'*************************************************
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM query1"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
Set ws = CreateObject("Excel.Application")
With ws
.Workbooks.Add
.Visible = True
End With
ws.Sheets("sheet1").Select
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:Q").EntireColumn.AutoFit
rst.Close
End Function

Answer 1

我认为由于您的变量前缀而存在一些混淆。我冒昧地修改你的前缀并回答了问题。您需要Workbooks.Open(<<filename goes here>>)代替Workbooks.Add。所以尝试这个代码（未经测试，因为我没有Access）。最后，还有其他方法可以使用Access中的数据填充Excel，例如DataQuery。您可能希望使用Excel GUI进行调查。

Function WriteToExcel()
    Dim cnn As ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim strSQL As String
    Dim strPath As String
    Dim appXL As Excel.Application
    Dim wb As Excel.Workbook
    Dim wsSheet1 As Excel.Worksheet
    Dim i As Long
    '*************************************************
    'First stage is to take the first query and place it
    'On sheet1
    '*************************************************
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    strSQL = "SELECT * FROM query1"
    rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    rst.MoveFirst

    Set appXL = CreateObject("Excel.Application")
    With appXL
        'Set wb = .Workbooks.Add '<--- to create a new workbook
        Set wb = .Workbooks.Open("c:\temp\Myworkbook.xlsx") '<--- to open an exisiting workbook

        .Visible = True
    End With

    Set wsSheet1 = wb.Sheets("sheet1")
    wsSheet1.Select
    For i = 0 To rst.Fields.Count - 1
        wsSheet1.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
    Next
    wsSheet1.Range("a2").CopyFromRecordset rst
    wsSheet1.Columns("A:Q").EntireColumn.AutoFit
    rst.Close
End Function

使用access vba将表/查询的内容写入excel

1 个答案: