访问-使用数组数据创建SQL查询，然后导出到Excel

Question

I am trying to get multiple usernames from a single text box, then to search a database to list all sections a username has access to, and then export that data to an Excel spreadsheet. A single spread sheet would be nice, but multiple spread sheets would be fine.

I have managed to get the data to an array, and have the code to export to an Excel spreadsheet, but my knowledge at the moment of vba doesn't go far enough to be able to link this together, so it uses the SQL statement to search through the tables to get the information of the access each user has and then somehow either store it and dump it to a single spread sheet, or just save it to a new spreadsheet each time is searches the database.

I have looked around but can't see how the ways I have seen can be translated into what I want. I guess you'd have to put the SQL results back into an Array and then do a dump to excel somehow?

I don't even know if this is possible to do in vba.

Code that I currently have, which I know won't work in it's current state:

Private Sub Command12_Click()
Dim strSQL As String
Dim strQry As String
Dim selecteduser As String
Dim db As DAO.Database
Dim Qdf As QueryDef

Users = Me.Text13

Dim usernames() As String

usernames() = Split(Users, ",")

strSQL = "SELECT tblPra.praNo, tblFolder.folder, tblFolder.fullTitle FROM "&_ 
     "tblPra INNER JOIN (tblFolder INNER JOIN tblRelationship ON " &_
     "tblFolder.folderID = tblRelationship.folderID) ON " &_
     "tblPra.praID = tblRelationship.praID " &_
     "WHERE (((tblPra.praNo)='" & usernames & "'));"
strQry = "tempuser"

Set db = CurrentDb
Set Qdf = db.CreateQueryDef(strQry, strSQL)

On Error Resume Next
    DoCmd.DeleteObject acQuery, "strQry"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
   strQry, "C:\Users\name\Desktop\test.xls", True

DoCmd.DeleteObject acQuery, strQry

End Sub

Any help, advice or point in the right direction would be greatly appreciated!

Answer 1

You could use an IN clause:

usernames() = Split(Users, ",")

strSQL = "SELECT tblPra.praNo, tblFolder.folder, tblFolder.fullTitle FROM "&_ 
     "tblPra INNER JOIN (tblFolder INNER JOIN tblRelationship ON " &_
     "tblFolder.folderID = tblRelationship.folderID) ON " &_
     "tblPra.praID = tblRelationship.praID " &_
     "WHERE (((tblPra.praNo) IN ('" & Join(usernames, "','") & "')));"

Answer 2

For export data to existing Excel template you can use code like this:

Dim usernames() As String
Dim strSQL As String
Dim xlApp As Excel.Application
Dim xlWork As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rst As Recordset

usernames() = Split(Users, ",")

strSQL = "SELECT tblPra.praNo, tblFolder.folder, tblFolder.fullTitle FROM "&_
     "tblPra INNER JOIN (tblFolder INNER JOIN tblRelationship ON " &_
     "tblFolder.folderID = tblRelationship.folderID) ON " &_
     "tblPra.praID = tblRelationship.praID " &_
     "WHERE (((tblPra.praNo) IN ('" & Join(usernames, "','") & "')));"


Set rst = CurrentDb.OpenRecordset(strSQL)

Set xlApp = CreateObject("Excel.Application")
Set xlWork = xlApp.Workbooks.Open("c:\temp\MyExcelTemplate.xlsx")
Set xlSheet = xlWork.Sheets("Sheet1")

xlSheet.Range("A1").CopyFromRecordset rst

Using Excel objects xlApp , xlWork , xlSheet will allow you keep template formatting, you will be able to create new worksheets, workbooks, make multiple data transfers, copy/set formatting, validation etc - use all Excel features. CopyFromRecordset works very fast.

This code requires reference to Microsoft Excel 15.0 Object Library