Data van access versturen naar excel in verschillende sheets.

Status
Niet open voor verdere reacties.
A

allard1977

Gebruiker
Lid geworden
7 feb 2011
Berichten
215
Hallo,

Ik heb een code gemaat dat data verstuurd naar excel. Alleen ik zou graag mijn data willen exporteren naar verschillende sheets.
Code: 
Private Sub ToExcel_Click()

    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim fld As DAO.Field
    Dim i As Integer
    
     
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("Copy Of Qry_HCreportStockExcel")
    Set rst = qdf.OpenRecordset()
    
    Set appExcel = New Excel.Application
    Set wbk = appExcel.Workbooks.Add()
    Set wks = wbk.Worksheets(1)
    
    For i = 0 To rst.Fields.Count - 1
        wks.Cells(1, i + 1).value = rst.Fields(i).Name
    Next i
    
    wks.Range("A2").CopyFromRecordset rst
    
    appExcel.Visible = True
    
End Sub
en een voorbeeld.
https://1drv.ms/f/s!AhopVOFNhS5Ni7ENcnxE8qXiIW5sVQ?e=8cIYE3

Alvast heel erg bedankt.
 
En welk formulier moeten we gebruiken? Of moet ik ze allemaal doorlopen? Gaat wel van jouw tijd af :)
 
Als u database opent komt formulier open. en de knop "High combine 3Q to excel" staat de vba code onder.
 
Nog een vraag: wat wil je nou precies? Je laadt één recordset en die gaat naar één werkblad. Tot zover snap ik 'm. Maar voor de rest laat je ons wel érg in het duister zitten :).
 
allard1977 zei:
Als u database opent komt formulier open. en de knop "High combine 3Q to excel" staat de vba code onder.
Klik om te vergroten...
Ik kom zó vaak beveiligde, of anderszins dwingend ingerichte database tegen op het forum, dat ik ze altijd met de Shift toets open, zodat ik tenminste overal bij kan :).
 
OctaFish zei:
Nog een vraag: wat wil je nou precies? Je laadt één recordset en die gaat naar één werkblad. Tot zover snap ik 'm. Maar voor de rest laat je ons wel érg in het duister zitten :).
Klik om te vergroten...

ik zou graag WTCH kolom als criteria hebben.
als WTCH is false in sheet 1 met als naam non-WTCH
Als WTCH is true graag in sheet2 met de naam WTCH

Dank u wel
 
In je voorbeeldje staan geen gegevens met WTCH aangevinkt. Dus dat schiet lekker op :).
 
het lijkt me het gemakkelijkst om gewoon de query 2 keer op te roepen, één keer met het criterium "where WTCH = 1" en het resultaat hiervan naar sheet1 te kopi_eren en een tweede keer met crit "where WTCH = 0" en dit resultaat naar sheet(2) kopiëren.
 
Dat was ik uiteraard van plan om te maken, maar er is geen data om dat te testen. Dus daar is het wachten op...
 
Heb er vandaag nog geen tijd voor gehad, maar ik zal er nog even naar kijken. Als de data klopt, en er is verschillende output, dan is het toch vrij simpel te maken. Ben dan wél benieuwd naar wat je zelf geprobeerd hebt.
 
Hallo Allard,

Geïnspireerd door je vraag bedacht ik me dat ik ook wel behoefte heb om in een van mijn databases zoiets te hebben. Ik heb voor een iets andere aanpak gekozen. De query's bouw ik bijvoorbeeld op in de code. Het principe voor het maken van meerdere sheets blijft hetzelfde. Wat ik tot nu tot heb is:
Code: 
Private Sub excelexport_Click()    Dim rs As DAO.Recordset
    Dim f As DAO.Field
    Dim xl As Excel.Application
    Dim wb As Excel.Workbook
    Dim i As Integer
    Dim j As Integer
    Dim strSQL As String
    
    Set xl = New Excel.Application
    Set wb = xl.Workbooks.Add()
       
    wb.Sheets.Add.Name = "LedenPerGroep"
    strSQL = "SELECT Voluit, Count(Nummer) AS Aantal " & _
             "FROM Groep INNER JOIN (Lid INNER JOIN Lid_in_Groep ON Lid.Nummer = Lid_in_Groep.Lid) ON Groep.Groep = Lid_in_Groep.Groep " & _
             "WHERE Nummer IN (SELECT Nummer From Lid WHERE " & _
             "Nz( Einddatum,#" & Format(Me.Standdatum + 1, "mm-dd-yyyy") & "#)>=#" & Format(Me.Standdatum, "mm-dd-yyyy") & "# AND " & _
             "Nz(Startdatum,#" & Format(Me.Standdatum - 1, "mm-dd-yyyy") & "#)<=#" & Format(Me.Standdatum, "mm-dd-yyyy") & "#) " & _
             "GROUP BY Voluit"


    Set rs = CurrentDb.OpenRecordset(strSQL)
             
    With rs
        i = 1
        j = 1
        
        For Each f In .Fields
            wb.Sheets("LedenPerGroep").Cells(i, j).Value = f.Name
            j = j + 1
        Next f
        
        While Not .EOF
            i = i + 1
            j = 1
            For Each f In .Fields
                wb.Sheets("LedenPerGroep").Cells(i, j).Value = f.Value
                j = j + 1
            Next f
            .MoveNext
        Wend
    End With
    
    
    wb.Sheets.Add.Name = "LeeftijdPerGroep"
    strSQL = "SELECT Geslacht, Count(Nummer) AS Aantal FROM Lid " & _
             "WHERE Nummer IN (SELECT Nummer From Lid WHERE " & _
             "Nz( Einddatum,#" & Format(Me.Standdatum + 1, "mm-dd-yyyy") & "#)>=#" & Format(Me.Standdatum, "mm-dd-yyyy") & "# AND " & _
             "Nz(Startdatum,#" & Format(Me.Standdatum - 1, "mm-dd-yyyy") & "#)<=#" & Format(Me.Standdatum, "mm-dd-yyyy") & "#) " & _
             "GROUP BY Geslacht"


    Debug.Print strSQL
    Set rs = CurrentDb.OpenRecordset(strSQL)
             
    With rs
        i = 1
        j = 1
        
        For Each f In .Fields
            wb.Sheets("LeeftijdPerGroep").Cells(i, j).Value = f.Name
            j = j + 1
        Next f
        
        While Not .EOF
            i = i + 1
            j = 1
            For Each f In .Fields
                wb.Sheets("LeeftijdPerGroep").Cells(i, j).Value = f.Value
                j = j + 1
            Next f
            .MoveNext
        Wend
        
    End With
        
    xl.Visible = True
End Sub
Kijk maar of je er wat aan hebt.
 
hoi ik was eerst hier mee bezig. mijn query is een kruistabel. dus ik weet niet hoe ik dit in deze code goed moet verwerken.
Code: 
strSQL =    "TRANSFORM Sum([Tbl_HCCount].Score) AS SumOfScore1 " & _
                "SELECT (Tbl03_Dogs.ExhibitorStock & " " & Tbl03_Dogs.ExhibitorStockJ) AS Exhibitor, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Sum([Tbl_SubHCCount].SumOfScore) AS Total Score " & _
                "FROM DateTrailDays INNER JOIN (DR_CLass_Level INNER JOIN (Tbl_SubHCCount INNER JOIN [Tbl_HCCount]
                ON Tbl_SubHCCount.Stamboomnr = [Tbl_HCCount].Stamboomnr and Tbl_SubHCCount.Stamboomnr = [Tbl03_Dogs].Stamboomnr)
                ON DR_CLass_Level.ClassID = [Tbl_HCCount].StockKlasID INNER JOIN Tbl03_Dogs)
                ON DateTrailDays.SanctionNR = [Tbl_HCCount].Trail INNER JOIN Tbl09_Stock ON DateTrailDays.SanctionNR = [Tbl09_Stock].Trail AND DR_CLass_Level.ClassID = [Tbl09_Stock].StockKlasID AND Tbl03_Dogs.Stamboomnr = [Tbl09_Stock].Stamboomnr) " & _
                "WHERE Tbl03_Dogs.WTCH = True" & _
                "GROUP BY ExhibitorStock & " " & ExhibitorStockJ, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Tbl_SubHCCount.SumOfScore " & _
                "ORDER BY Tbl03_Dogs.WTCH " & _
                "PIVOT [DR_CLass_Level].[Class_LevelName] & " " & [DateTrailDays].Date & "" & [DateTrailDays].Timepoint & " " & [DateTrailDays].Judge;"

alvast bedankt.

Allard
 
Laatst bewerkt:
Wat is nu eigenlijk je probleem? Ik ging er vanuit dat het probleem vooral was hoe je twee wekbladen aanmaakt in een werkboek. In de code kan je zien hoe ik dat doe.
Hoe je de gegevens selecteert maakt niet uit. Als dat op jouw manier (met verwijzing naar een query) voor één werkblad werkt, kan je die werkwijze kopiëren voor het tweede weekblad. Het enige dat je dan wel moet doen is twee query's maken: een voor WAAR en een voor ONWAAR.
 
ik ben bezig met uw code. ik heb een crosstable die ik probeer te verwerken in de strSQL. alleen ik krijg nu een fout melding syntaxisfout. en ik denk dat het in dit stukje zit.
Code: 
(Tbl03_Dogs.ExhibitorStock & " " & Tbl03_Dogs.ExhibitorStockJ) AS Exhibitor
 
Hallo ben weer een stap verder.
alleen ik krijg een fout melding "Syntax error in TRANSFORM statement."
Code: 
Private Sub ToExcel_Click()
On Error GoTo Error_Handler
    Dim F As DAO.Field
    Dim xl As Excel.Application
    Dim WB As Excel.Workbook
    Dim i As Integer
    Dim j As Integer
    Dim strSQL As String
    Dim rs As DAO.Recordset
    
    Set xl = New Excel.Application
    Set WB = xl.Workbooks.Add()
       
    WB.Sheets.Add.Name = "WTCH"
    strSQL = "TRANSFORM Sum(Tbl_HCCount.Score) AS SumOfScore " & _
                "SELECT (Tbl03_Dogs.ExhibitorStock &"" ""& Tbl03_Dogs.ExhibitorStockJ) AS Exhibitor, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, ([Tbl_SubHCCount].SumOfScore) AS Total Score " & _
                "FROM DateTrailDays INNER JOIN (DR_CLass_Level INNER JOIN (Tbl_SubHCCount INNER JOIN [Tbl_HCCount] ON Tbl_SubHCCount.Stamboomnr = [Tbl_HCCount].Stamboomnr) ON DR_CLass_Level.ClassID = [Tbl_HCCount].StockKlasID INNER JOIN Tbl03_Dogs ON Tbl_SubHCCount.Stamboomnr = [Tbl03_Dogs].Stamboomnr) ON DateTrailDays.SanctionNR = [Tbl_HCCount].Trail INNER JOIN Tbl09_Stock ON DateTrailDays.SanctionNR = [Tbl09_Stock].Trail AND DR_CLass_Level.ClassID = [Tbl09_Stock].StockKlasID AND Tbl03_Dogs.Stamboomnr = [Tbl09_Stock].Stamboomnr " & _
                "WHERE Tbl03_Dogs.WTCH = True " & _
                "GROUP BY ExhibitorStock &""  ""& ExhibitorStockJ, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Tbl_SubHCCount.SumOfScore " & _
                "ORDER BY Tbl03_Dogs.WTCH " & _
                "PIVOT [DR_CLass_Level].[Class_LevelName] &"" ""& [DateTrailDays].Date &""""& [DateTrailDays].Timepoint &"" ""& [DateTrailDays].Judge; "


    
    Set rs = CurrentDb.OpenRecordset(strSQL)
             
    With rs
        i = 1
        j = 1
        
        For Each F In .Fields
            WB.Sheets("WTCH").Cells(i, j).value = F.Name
            j = j + 1
        Next F
        
        While Not .EOF
            i = i + 1
            j = 1
            For Each F In .Fields
                WB.Sheets("WTCH").Cells(i, j).value = F.value
                j = j + 1
            Next F
            .MoveNext
        Wend
    End With
    
    
    WB.Sheets.Add.Name = "NON_WTCH"
    strSQL = "TRANSFORM Sum(Tbl_HCCount.Score) AS SumOfScore " & _
                "SELECT (Tbl03_Dogs.ExhibitorStock &"" ""& Tbl03_Dogs.ExhibitorStockJ) AS Exhibitor, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Sum([Tbl_SubHCCount].SumOfScore) AS Total Score " & _
                "FROM DateTrailDays INNER JOIN (DR_CLass_Level INNER JOIN (Tbl_SubHCCount INNER JOIN [Tbl_HCCount] ON Tbl_SubHCCount.Stamboomnr = [Tbl_HCCount].Stamboomnr) ON DR_CLass_Level.ClassID = [Tbl_HCCount].StockKlasID INNER JOIN Tbl03_Dogs ON Tbl_SubHCCount.Stamboomnr = [Tbl03_Dogs].Stamboomnr) ON DateTrailDays.SanctionNR = [Tbl_HCCount].Trail INNER JOIN Tbl09_Stock ON DateTrailDays.SanctionNR = [Tbl09_Stock].Trail AND DR_CLass_Level.ClassID = [Tbl09_Stock].StockKlasID AND Tbl03_Dogs.Stamboomnr = [Tbl09_Stock].Stamboomnr " & _
                "WHERE Tbl03_Dogs.WTCH = 'False' " & _
                "GROUP BY ExhibitorStock &""  ""& ExhibitorStockJ, Tbl09_Stock.JrHandlerYes, Tbl03_Dogs.naamhond, Tbl03_Dogs.WTCH, Tbl_SubHCCount.SumOfScore " & _
                "ORDER BY Tbl03_Dogs.WTCH " & _
                "PIVOT [DR_CLass_Level].[Class_LevelName] &"" ""& [DateTrailDays].Date &""""& [DateTrailDays].Timepoint &"" ""& [DateTrailDays].Judge; "



    Debug.Print strSQL
    Set rs = CurrentDb.OpenRecordset(strSQL)
             
    With rs
        i = 1
        j = 1
        
        For Each F In .Fields
            WB.Sheets("NON_WTCH").Cells(i, j).value = F.Name
            j = j + 1
        Next F
        
        While Not .EOF
            i = i + 1
            j = 1
            For Each F In .Fields
                WB.Sheets("NON_WTCH").Cells(i, j).value = F.value
                j = j + 1
            Next F
            .MoveNext
        Wend
        
    End With
        
    xl.Visible = True

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ToExcel_Click" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit
    
End Sub

en voorbeeld
https://1drv.ms/u/s!AhopVOFNhS5Ni7IytO6YvvlsKgP9QQ?e=1ZI5So

alvast heel erg bedankt.
 
Sorry, ik heb het geprobeerd maar de query zit (voor mij) zo ingewikkeld in elkaar dat ik er niet uitkom om hem draaiend te krijgen. Ik strompel van fout naar fout.

Het enige dat ik je kan adviseren is terug te gaan naar je oorspronkelijke opzet met één query en één werkblad. Ik neem aan dat die op zich werkte. Het voornaamste dat je aan moet passen is dat je twee query's maakt op basis van "Copy Of Qry_HCreportStockExcel". Een voor WTCH is WAAR en een voor WTCH is ONWAAR. Ik heb een voorbeeld voor de WAAR query gemaakt.
 

Bijlagen

  • qWAAR.jpg
    qWAAR.jpg
    83,7 KB · Weergaven: 15
Laatst bewerkt:
Of je laat mij er naar kijkens :). Ik heb er nog weinig tijd voor gehad, maar het is absoluut oplosbaar.
 
Of je plakt de SQL van de aangepaste "Copy Of Qry_HCreportStockExcel" in je code. Daar had ik ff geen puf meer voor :(
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan