Comment exporter les résultats d'une instruction SQL dans un fichier Excel

Question

J'ai une base de données Access et un formulaire dans Excel VBA. Toutes les données que je saisis dans le DB sont entrées via le formulaire VBA.

Cette base de données contient toutes les cartes d'avantages que nous avons déjà reçues cette année dans l'entreprise. Mais le même employé peut demander la carte deux fois ou plus, donc nous aurons plus d'un enregistrement sur la base de données pour lui. Ce dont j'ai besoin est quand le nombre d'enregistrements est supérieur à un, le résultat de l'instruction SQL devrait apparaître dans un rapport Excel.

J'utilise l'instruction SELECT (*) COUNT pour savoir s'il existe plusieurs enregistrements compatibles avec le critère de recherche. Mais je ne peux pas faire apparaître le résultat dans un fichier Excel.

Voici mon code:

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 

Quand je lance ce code, il me donne de dire quelque chose comme un message:

Impossible de localiser la sortie du tableau OPENROWSET

Je ne suis pas en mesure d'installer de nouveaux programmes, donc je dois le faire en utilisant uniquement Excel VBA et la base de données Access.

Comment est-ce que je peux faire ce travail?

Answer 1

Je ne crois pas qu'Access supporte la table dynamique OPENROWSET avec laquelle vous travaillez. J'ai beaucoup de vieux projets qui font bien, voici donc ma méthode

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

J'ai eu ce défi il y a tant d'années que je ne me souviens pas, mais cet anneau de liaison de la cloche. Vérifiez si cela aide.

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

try {connw.Open(); Commande OleDbCommand; command = new OleDbCommand ("Mise à jour des livraisons" + "SET Deliveries.EmployeeID =?, Deliveries.FIN =?, Deliveries.TodaysOrders =?, connw); command.Parameters.Add (nouveau OleDbParameter (" @ EMPID ", Convert.ToDecimal (empsplitIt [1]))); command.Parameters.Add (nouveau OleDbParameter ("@ FIN", truckSplit [1] .ToString())); command.Parameters.Add (nouveau OleDbParameter ("@ TodaysOrder", "R ")); catchReturnedRows = commande.ExecuteNonQuery(); // Valider connw.Close();} catch (exception OleDbException) {MessageBox.Show (exception.Message," Exception OleDb ");}

Answer 3

vous pouvez utiliser ce, pour imprimer le SQL réel.

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 

Voici une version plus pour vous. cela exporter les résultats de chaque requête, chacun un fichier texte séparé.

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