Query exporteren naar Excel

[mschrijver]

Goedemorgen allen,

Ik wil graag het resultaat van een query exporteren naar Excel. De afgelopen dagen ben ik dan ook druk bezig geweest met zoeken naar de beste manier om dit te realiseren.

Uiteindelijk kwam ik tot de volgende en simpele code:

Private Sub btn_Excel_Click()

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Query_Controlekaart_Blanco_91d", "P:\17\10_Cluster_17_Algemeen\98_Overige\MSH\Vliegas_Testfase\Excel bladen\Contolekaart Blanco 91 daagse", , "Export"
End Sub

Wat hij doet is vrij simpel. Zodra de knop wordt ingedrukt wordt de vba code gestart die het resultaat van query Query_Controlekaart_Blanco_91d exporteert naar het tabblad Export van het Excelblad Excelblad Contolekaart Blanco 91 daagse.
En dat werkt prima.

Echter, ik ben wel een probleem tegengekomen. Elke keer dat de gebruiker op die knop drukt, wordt het tabblad 'Export' leeggehaald en weer opnieuw gevuld.

Mijn vraag;

Wat ik graag zou willen is dat de voorheen geexporteerde data behouden blijft. Enig idee hoe ik dit kan realiseren?

Ik heb het geprobeerd op te lossen door de code te herschrijven en gebruik te maken van het Excel Object binnen VBA, echter doet hij niets op het moment dat ik op de knop druk en ik heb geen idee waarom hij niets doet.

De VBA code die ik reeds gebruikt heb:

Private Sub btn_Kaart2_Click()
Dim rstName As Recordset
Set rstName = CurrentDb.OpenRecordset("Query_Controlekaart_Blanco_28d")

Dim objApp As Object, objMyWorkbook As Object, objMySheet As Object, objMyRange As Object

Set objApp = CreateObject("Excel.Application")
Set objMyWorkbook = objApp.Workbooks.Open("P:\17\10_Cluster_17_Algemeen\98_Overige\MSH\Vliegas_Testfase\Excel bladen\Contolekaart Blanco 28 daagse.xls")
Set objMySheet = objMyWorkbook.Worksheets("Export")
Set objMyRange = objMySheet.Cells(objApp.ActiveSheet.UsedRange.Rows.Count + 1, 1)

With objMyRange
 rstName.MoveFirst 'Rewind to the first record
 .Clear
 .CopyFromRecordset rstName
End With
End Sub

Enig idee wat hier fout aan is?

Alvast bedankt!

 

[OctaFish]

Je denkwijze is goed, je uitvoering nog niet. Ik heb 'm aangepast (twee varianten: Late Binding en Early Binding) en zo werkt hij prima:

'---------------------------------------------------------------------------------
'Code met Early Binding
'---------------------------------------------------------------------------------
Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim objRng As Excel.Range
    Set objExcel = CreateObject("Excel.Application")
    Set objWB = objExcel.Workbooks.Open(sFile)
    Set objSht = objWB.Worksheets("Export")
    Set objRng = objSht.Cells(objSht.UsedRange.Rows.Count + 1, 1)
    objRng.CopyFromRecordset rst
    objWB.Close SaveChanges:=True
    objExcel.Quit
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'---------------------------------------------------------------------------------
'Code met Late Binding
'---------------------------------------------------------------------------------
Dim objApp As Object, objMyWB As Object, objMySht As Object, objMyRng As Object
    Set objApp = CreateObject("Excel.Application")
    Set objMyWB = objApp.Workbooks.Open(sFile)
    Set objMySht = objMyWB.Worksheets("Export")
    Set objMyRng = objMySht.Cells(objMySht.UsedRange.Rows.Count + 1, 1)
    objMyRng.CopyFromRecordset rst
    objMyWB.Close SaveChanges:=True
    objApp.Quit
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 

[mschrijver]

Hartelijk dank voor je snelle reactie. Ik ga het even proberen.

Cheers!

 

[mschrijver]

Ik neem aan dat ik 'sfile' moet vervangen door de locatie van het excelblad?

 

[OctaFish]

Ik heb inderdaad de bestandsnaam in een variabele gezet. Kun je natuurlijk ook doen; houdt je code wat overzichtelijker

 

[mschrijver]

Duidelijk. Nogmaals hartelijk dank.

Ik ga even stoeien .

 

[mschrijver]

objMyRng.CopyFromRecordset rst

Is rst ook één van de variabelen die je gebruik hebt ?

Ik neem aan dat het rstName moet zijn (naam query opgenomen in Recordset) en stoei even verder

 

[OctaFish]

Ik hou van simpele namen in variabelen. Boeken schrijven bewaar ik wel voor de nieuwsbrief

 

[mschrijver]

Ik durf het bijna niet te vragen, maar zou je me nog een zetje in de juiste richting kunnen geven? Ik krijg hem maar niet aan de praat, er gebeurt simpelweg niets als ik op de knop druk.

Private Sub Knop312_Click()


Dim rstName As Recordset
Dim sfile As String

Set rstName = CurrentDb.OpenRecordset("Query_Controlekaart_Blanco_28d")
[B]sfile = "P:\17\10_Cluster_17_Algemeen\98_Overige\MSH\Vliegas_Testfase\Excel bladen\Contolekaart Blanco 28 daagse.xls"[/B]

Dim objApp As Object, objMyWB As Object, objMySht As Object, objMyRng As Object
    Set objApp = CreateObject("Excel.Application")
    Set objMyWB = objApp.Workbooks.Open(sfile)
    Set objMySht = objMyWB.Worksheets("Export")
    Set objMyRng = objMySht.Cells(objMySht.UsedRange.Rows.Count + 1, 1)
    objMyRng.CopyFromRecordset [B]rstName[/B]
    objMyWB.Close SaveChanges:=True
    objApp.Quit


End Sub

Enige wat ik heb toegevoegd is variabele 'sfile' vervolgens heb ik de naam van de variabele die de recordset bevat opgegeven bij de CopyFromRecordSet functie.
Is er nog iets wat ik over het hoofd heb gezien?

 

[OctaFish]

Het kan zijn dat je de bibliotheek nader moet specificeren. Je krijgt dan:

Dim rstName As DAO.Recordset

Verder is het dezelfde code als die ik zelf gebruik, dus daar kan het niet aan liggen. Ik neem aan dat er netjes records in de query zitten?

 

[mschrijver]

Er zitten inderdaad records in de query.

Bedankt voor de tip (DAO). Echter wil het nog niet werken.

Ik ga er wederom voor zitten, zodra ik iets tegenkom zal ik het je laten weten. En mocht je nog wat te binnen schieten, im all ears .

 

[OctaFish]

Wat ik ook probeer, ik krijg 'm niet niet aan de praat.... Voor de gein heb ik er een flexibelere functie van gemaakt; die werkt uiteraard ook al tadellos...

Private Sub Knop0_Click()
Dim sFile As String, sWS As String
Dim rst As String

    rst = "qryZoeken"
    sFile = "H:\qCategorieën.xls"
    sWS = "Export"
    Call LateBinding(rst, sFile, sWS)
    Call EarlyBinding(rst, sFile, sWS)
End Sub

Function LateBinding(QueryName As String, FileName As String, WorkSheetName As String)
'---------------------------------------------------------------------------------
'Code met Late Binding
'---------------------------------------------------------------------------------
Dim objApp As Object, objMyWB As Object, objMySht As Object, objMyRng As Object
Dim rst As DAO.Recordset

    Set rst = CurrentDb.OpenRecordset(QueryName)
    Set objApp = CreateObject("Excel.Application")
    Set objMyWB = objApp.Workbooks.Open(FileName)
    Set objMySht = objMyWB.Worksheets(WorkSheetName)
    Set objMyRng = objMySht.Cells(objMySht.UsedRange.Rows.Count + 1, 1)
    objMyRng.CopyFromRecordset rst
    objMyWB.Close SaveChanges:=True
    objApp.Quit
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
End Function

Function EarlyBinding(QueryName As String, FileName As String, WorkSheetName As String)
'---------------------------------------------------------------------------------
'Code met Early Binding
'---------------------------------------------------------------------------------
Dim rst As DAO.Recordset
Dim objExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim objRng As Excel.Range

    Set rst = CurrentDb.OpenRecordset(QueryName)
    Set objExcel = CreateObject("Excel.Application")
    Set objWB = objExcel.Workbooks.Open(FileName)
    Set objSht = objWB.Worksheets(WorkSheetName)
    Set objRng = objSht.Cells(objSht.UsedRange.Rows.Count + 1, 1)
    objRng.CopyFromRecordset rst
    objWB.Close SaveChanges:=True
    objExcel.Quit
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
End Function

 

[mschrijver]

Goedemorgen Octafish,

Hartelijk dank voor uw tijd en hulp.

De door jouw geplaatste code (hierboven) werkt inderdaad als een trein.

Nogmaals bedankt!