如何將 SQL 語句結果導出到 Excel 文件

Question

我有一個 Access 數據庫和一個 Excel VBA 表單。 我輸入到DB的所有數據都是通過VBA形式輸入的。

該數據庫包含我們今年在公司收到的所有福利卡。 但是同一個員工可以要求兩次或更多次的卡，因此我們將在數據庫中為他保留不止一條記錄。

我需要的是當記錄數大於1時，SQL語句結果應該出現在Excel報表中。

我使用SELECT (*) COUNT語句來了解何時存在多個與搜索條件兼容的記錄。 但我無法讓結果出現在 Excel 文件中。

這是我的代碼：

Public Function Relatorio()
    Dim sql As String
    Dim cn  As ADODB.Connection
    Dim rs  As ADODB.Recordset
    Dim rel As String

    Set cn = New ADODB.Connection
    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"
    cn.Open
    Set rs = New ADODB.Recordset
    sql = "INSERT INTO OPENROWSET('Microsoft.ACE.OLEDB.12.0', 'Excel 12.0;Database=" & enderecoDB & ";', 'SELECT * FROM [Planilha1$]') SELECT * FROM controle WHERE BP = " & controlectform.nmbpbox.Value & ";"
    rs.Open sql, cn
End Function

當我運行此代碼時，它會給我一條消息，內容如下：

找不到 OPENROWSET 表出口

我無法安裝新程序，因此我只需要使用 Excel VBA 和 Access DB 來執行此操作。

我怎樣才能使這項工作？

Answer 1

我不相信 Access 支持您在那里使用的 OPENROWSET 動態表。 我有很多舊項目都這樣做，所以這是我的方法

Public Function Relatorio()

    Dim sql As String
    Dim cn  As ADODB.Connection
    Dim rs  As ADODB.Recordset
    Dim rel As String


    Set cn = New ADODB.Connection

    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"

    cn.Open

    Set rs = New ADODB.Recordset

    dim path_To_XLSX
    dim name_of_sheet
    path_To_XLSX = "c:\temp\output.xlsx"
    name_of_sheet = "Planilha1"
    sql = sql = "SELECT * INTO [Excel 12.0;Database=" & path_To_XLSX & "]." & name_of_sheet & " FROM controle WHERE BP = '" & controlectform.nmbpbox.Value & "';" 

    rs.Open sql, cn

    'If this application is in an unsecure environment, use the following code instead!  This is to prevent a SQL injection, security concern here.
    'As it is an Access Database, this is likely overkill for this project
    'Create Command Object.
    Set Cmd1 = New ADODB.Command
    Cmd1.ActiveConnection = cn
    cmd1.CommandText = "SELECT * FROM controle INTO [Excel 12.0;Database=" & path_To_XLSX & "]." & name_of_sheet & " WHERE BP = ?"
    ' Create Parameter Object.
    Set Param1 = Cmd1.CreateParameter(, adInteger, adParamInput, 5) 'use adVarchar for strings(versus adInteger), https://www.w3schools.com/asp/met_comm_createparameter.asp
    Param1.Value = controlectform.nmbpbox.Value
    Cmd1.Parameters.Append Param1
    Set Param1 = Nothing
    Set Rs = Cmd1.Execute()

End Function

Answer 2

多年前我遇到了這個挑戰，我不記得了，但是這個鏈接敲響了警鍾。 檢查它是否有幫助。

https://stackoverflow.com/a/28889774/382588

嘗試 { connw.Open(); OleDbCommand 命令； command = new OleDbCommand( "Update Deliveries " + "SET Deliveries.EmployeeID = ?, Deliveries.FIN = ?, Deliveries.TodaysOrders = ? , connw); command.Parameters.Add(new OleDbParameter("@EMPID", Convert.ToDecimal (empsplitIt[1]))); command.Parameters.Add(new OleDbParameter("@FIN", truckSplit[1].ToString())); command.Parameters.Add(new OleDbParameter("@TodaysOrder", "R ")); catchReturnedRows = command.ExecuteNonQuery();//Commit connw.Close(); } catch (OleDbException exception) { MessageBox.Show(exception.Message, "OleDb Exception"); }

Answer 3

您可以使用它來打印實際的 SQL。

Private Sub Command2_Click()

Dim db As Database
Dim qr As QueryDef

Set db = CurrentDb

For Each qr In db.QueryDefs
  TextOut (qr.Name)
  TextOut (qr.SQL)
  TextOut (String(100, "-"))
Next

End Sub

Public Sub TextOut(OutputString As String)

    Dim fh As Long

    fh = FreeFile
    Open "C:\Users\rs17746\Desktop\Text_Files\sample.txt" For Append As fh
    Print #fh, OutputString
    Close fh

End Sub

這是給你的另一個版本。 這會將每個查詢的結果導出到一個單獨的文本文件中。

Private Sub Command0_Click()


Dim qdf As QueryDef
Dim strFileName As String
For Each qdf In CurrentDb.QueryDefs
If Left(qdf.Name, 1) <> "~" Then

'you need to figure out TransferText command. Maybe
'you won't be lazy and expect people to read it to
'you and tutor you on how it works.
strFileName = qdf.Name

'Docmd.TransferText ....
DoCmd.TransferText transferType:=acExportDelim, TableName:=strFileName, FileName:="C:\test\" & strFileName & ".txt", hasfieldnames:=True

End If
Next qdf
MsgBox "Done"


End Sub