Access 2016. Export current record naar Excel

[KPTPTT]

Hallo,
Ik zit met een hardnekkig probleem. Ik wil vanuit een tabel de huidige record van een formulier/tabel exporteren naar Excel. Een tabel exporteren dmv. VBA lukt mij wel maar uitgebreid met een filter geeft hardnekkige problemen.
Ik gebruik een VBA code die jaren geleden op Helpmij (oa. Octafish, 30-9-2009) is geplaatst. Daarin wordt een tijdelijke Query TEMP gebruikt. Volgens mij werkt het filter goed, de ID wordt correct genummerd. Moet ik Temp nog declareren? Is Temp een query of een excel bestand (zie kill instructie (xlsx))? Bij de uitvoering kan access het object Temp niet vinden. Ik zie dat ik gebruik moet maken van DAO. Als ik de DAO library wil instellen, dan wordt een foutmelding gegeven: "De opgegeven naam is strijdig met een bestaand object, een bestaande module of een bestaande objectbibliotheek". Dus ik kan dit niet instellen. Heeft iemand een tip, alvast dank.

Private Sub Knop288_Click()
Dim db As Database
Dim xlWorksheetPath As String
Dim has_header As Boolean
Dim cn As ADODB.Connection
Dim strSQL As String
Dim pad As String

    Set db = CurrentDb()
    Set cn = New ADODB.Connection
    pad = CurrentProject.Path
    If Right(pad, 1) <> "\" Then pad = pad & "\"
    xlWorksheetPath = "D:\vba test database 5.0\"
    xlWorksheetPath = xlWorksheetPath & "test vba testdatabase_5.0.xlsx"

'Instantiate Excel objects:
Workbooks.Open (xlWorksheetPath)

'Export headers with data:
    has_header = True
    
' Selecteer alles (*) naar tabel Temp
' vanuit tabel Voorkamer
' waar geldt: ID is gelijk aan ID huidige record
strSQL = "SELECT * INTO Temp"
strSQL = strSQL & "FROM [materialen] "
strSQL = strSQL & "WHERE([vk_Pand_ID] = " & Me.PandID & ");"

    On Error Resume Next
    Kill pad & "\Test.xls"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True

        On Error GoTo 0
        'Transport tabel naar Excel werkblad en sluit Excel
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Temp", xlWorksheetPath
        ActiveWorkbook.Close True
        MsgBox "Alle gegevens zijn naar Excel getransporteerd. Open het Excel-bestand."

End Sub

 

[OctaFish]

2009 zei je.... In de tussentijd weer wat bijgeleerd blijkbaar . Ik zou het nu zo doen:

Dim qTmp As QueryDef
    Set cn = New ADODB.Connection
    pad = CurrentProject.Path & IIf(Right(CurrentProject.Path, 1) <> "\", "\", "")
    xlWorksheetPath = pad & "test vba testdatabase_5.0.xlsx"
 
    strSQL = "SELECT * FROM [TBL_Taken] WHERE [TaakID] = 7"
    Set qTmp = CurrentDb.QueryDefs("qTemp")
    qTmp.SQL = strSQL
 
    'Transport tabel naar Excel werkblad
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "qTemp", xlWorksheetPath, True
    MsgBox "Alle gegevens zijn naar Excel getransporteerd. Open het Excel-bestand."

 

[KPTPTT]

Dank je. Bij het uitvoeren c.q. debuggen blijft de code steken bij: Set gTmp = CurrentDb.QueryDefs("gTmp") Fout 3256, Kan het element niet vinden in deze collectie. Ook vind ik het vreemd dat je geen filter in de Where voorwaarde plaatst maar een constant getal 7.

 

[OctaFish]

Ik had de tempquery qTmp genoemd, niet gTmp. dat zou een verschil kunnen zijn. Ik heb jouw db niet, dus ik heb even getest met een vaste waarde i.p.v. een waarde uit een formulier dat ik niet heb. Mag je uiteraard weer terugzetten.

 

[KPTPTT]

Zou je svp nog eens willen kijken. De resultaten van de debug stoppen bij de export commando <DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "qTemp", xlWorksheetPath, True> . Kan het object Temp niet vinden. Het is toch gedeclareerd.

Moet ik qTemp ook met DIm definiëren?
Moet ik Dim qTemp As QueryDef ook niet definiëren?
Als ik <Set qTmp = CurrentDb.QueryDefs("qTemp") > QueryDef gebuik krijg ik ook een foutmelding. Is dat ook goed gedaan bij de DIM instructie?

Ik heb veel geprobeerd maar de fout blijft. De Excel wordt wel geopend maar niet gesloten (programma stopt immers) met alle gevolgen van dien. Het is lastig om het programma op te sturen.

Private Sub Knop354_Click()
    Dim qTmp As QueryDef
                        'Dim qTemp As QueryDef
    Dim db As Database
    Dim xlWorksheetPath As String
    Dim has_header As Boolean
    Dim strSQL As String
    Dim pad As String
    
    Set cn = New ADODB.Connection
    Set db = CurrentDb()
    pad = CurrentProject.Path
    If Right(pad, 1) <> "\" Then pad = pad & "\"
    xlWorksheetPath = "D:\aannemersbedrijf\vba opname databse 5.0\"
    xlWorksheetPath = xlWorksheetPath & "test vba opname database_5.0.xlsx"
    
    'Instantiate Excel objects:
    Workbooks.Open (xlWorksheetPath)

    'Export headers with data:
    has_header = True
    
    strSQL = "SELECT * FROM [kamer] WHERE ([vk_Pand_ID] = " & Me.PandID & ");"
    Set qTmp = CurrentDb.QueryDefs("qTemp")
    qTmp.SQL = strSQL
    
    'Transport tabel naar Excel werkblad
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "qTemp", xlWorksheetPath, True
    ActiveWorkbook.SaveAs
    AddToRecentFiles = True
    ActiveWorkbook.Close True
    
    MsgBox "Alle gegevens zijn naar Excel getransporteerd. Open het Excel-bestand."
End Sub

 

[OctaFish]

Je gebruikt mijn code niet, maar je opent nog steeds (m.i. volslagen overbodig) Excel met een workbook. Ik kan voor de correcte code dus gewoon naar bericht #2 verwijzen. Enige aantekening daarbij: die code werkt alleen als je een query hebt gemaakt die 'qTemp' heet, want die wordt geopend door de QueryDef qTmp. Dus hij moet wel bestaan. Omdat die query verder toch wordt verbouwd, kun je elke willekeurige bestaande query pakken, daar een kopie van maken en die omdopen naar qTemp. Dan werkt alles.

 

[KPTPTT]

Octafisch. Eureka, de laatste tip was de super. Bedankt. Ik had niet door dat er een "fake" query gemaakt moest worden. Het is de oplossing en de (gefilterde) export naar Excel is gelukt, top.

Ik heb nog wel een volgende vraag. In de access tabellen zijn de gegevenstype van alle numerieke velden is de standaardwaarde op 0 gezet en de tekst-uitlijning links. In de formulieren tonen sommige velden de waarde 0 en andere niet (leeg veld). Daarbij zijn sommige velden links en andere velden rechts uitgelijnd. Als ik de tabel exporteer, dan hebben ook maar een paar cellen de waarde 0. Ik krijg dit niet anders. Hoe kan ik alle velden de waarde 0 laten tonen en links uitgelijnd.

 

[OctaFish]

Geen idee waarom je verkeerde output krijgt; dan zou ik de db moeten zien. Wat betreft de QDefs: als ik niet lui ben, controleer ik eerst of de query wel bestaat, en zo niet: dan maak ik 'm aan. Dan weet je zeker dat de procedure altijd werkt.