resultaat query in excel plaatsen

[asmeets]

Hallo allemaal,

Ik ben op zoek naar voorbeeldcode waarmee ik het resultaat van een query in een excel sheet kan plaatsen en opmaken.

De 3e rij van de sheet zal de kolomkoppen bevatten, die gevuld worden door de naemen van de velden die opgervaagd worden. De 5e rij en lager zal de inhoud van ieder opgevraagde rij uit de query bevatten

Als iemand hier iets voor heeft hou ik me aanbevolen. Informatie over de query hoef ik niet te hebben dat werk al.

Ad

 

[Guus2005]

Probeer deze code eerst.

De volgende code is van mijzelf. Hij is practisch niet gedocumenteerd. Probeer er eerst zelf achter te komen hoe het werkt. Het exporteert een query naar excel. Zet de code in een module.

Option Compare Database
Option Explicit

Public Sub CreateSpreadsheet(strQry As String, Optional blnHeader As Boolean = True)
'Resultaat van een query exporteren naar excel.

    Dim appExcel  As Excel.Application
    Dim wbExcel   As Workbook
    Dim wsExcel   As Worksheet
    Dim rst       As Recordset
    Dim qdf       As QueryDef
    Dim intRij    As Integer
    Dim intVelden As Integer
    Dim intTeller As Integer
        
    Set qdf = CurrentDb.QueryDefs(strQry)
    Set rst = qdf.OpenRecordset
    
    CreateSpreadsheetFromRS rst

    Set rst = Nothing
    Set qdf = Nothing

End Sub

Public Sub CreateSpreadsheetFromRS(rst As Recordset, Optional blnHeader As Boolean = True)
'Recordset exporteren naar excel.

    Dim appExcel  As Excel.Application
    Dim wbExcel   As Workbook
    Dim wsExcel   As Worksheet
    Dim qdf       As QueryDef
    Dim intRij    As Integer
    Dim intVelden As Integer
    Dim intTeller As Integer
        
    If Not rst.EOF Then
        Set appExcel = New Excel.Application
        With appExcel
            .Visible = True
            Set wbExcel = .Workbooks.Add
            Set wsExcel = wbExcel.Worksheets(1)
        End With
    Else
        MsgBox "Geen records gevonden", vbExclamation
        Exit Sub
    End If
    
    intVelden = rst.Fields.Count - 1
        
    intRij = 0
    
    If blnHeader Then 'Default worden de veldnamen geprint
        'Eerst de veldnamen
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller).Name
        Next intTeller
    End If
                
    Do While Not rst.EOF
        intRij = intRij + 1
        For intTeller = 0 To intVelden
            wsExcel.Cells(intRij, intTeller + 1) = rst.Fields(intTeller)
        Next intTeller
        rst.MoveNext
    Loop
        
    wsExcel.Columns.AutoFit
    
    Set rst = Nothing
    Set qdf = Nothing

End Sub
Public Sub RunReport(intQryNummer As Integer, _
                 Optional intYear As Integer = 2007, _
             Optional intMaand As Integer = 0)

    Dim strQueryname As String
    Dim qdf As QueryDef
    Dim rst As Recordset
    
    Select Case intQryNummer
        Case 1
            strQueryname = "qrptSelRapportCCA"
            Set qdf = CurrentDb.QueryDefs(strQueryname)
        Case 2
            strQueryname = "qrptUrenVoorSapMM"
            Set qdf = CurrentDb.QueryDefs(strQueryname)
            qdf.Parameters("ParameterMaand").Value = intMaand
            qdf.Parameters("ParameterJaar").Value = CStr(intYear)
        Case Else
            MsgBox "Deze query is nog niet bekend", vbExclamation
            Exit Sub
    End Select

    Set rst = qdf.OpenRecordset(dbOpenSnapshot)

    CreateSpreadsheetFromRS rst

End Sub

Enjoy!