Excel VBA tip 6: Gegevens met een recordset uit meerdere bestanden uitlezen zonder bestanden te openen

Dit is de zesde blogpost uit de reeks die dieper ingaat op een aantal technieken die datatransformatie in Excel VBA kunnen versnellen.

  1. Kopiëren van cellen met VBA
  2. Gegevens toevoegen aan een tabel
  3. Een bestand openen en data overbrengen naar het doelbestand
  4. Een reeks bestanden openen en data overbrengen naar het doelbestand
  5. Gegevens opslaan in een recordset
  6. Gegevens uit meerdere bestanden met een recordset uitlezen zonder de bestanden te openen
  7. Een recordset maken, gebaseerd op data uit 2 verschillende worksheets

In de vorige blogpost hebben we gezien hoe data in een recordset opgeslagen kan worden. In deze blog gaan we die techniek gebruiken om alle bestanden in een folder te openen en hun data naar het doelbestand over te brengen. De kennis die nodig is om een bestand te openen kan je in de vorige blogs uit deze reeks terugvinden.

Ook in deze blog zullen we de klassieke methode (workbooks.open) met de recordset methode vergelijken.

Voor dit voorbeeld gebruik ik 20 identieke bestanden die elk 10 kolommen en 5000 rijen data bevatten. Het resultaat wordt zodoende een werkblad met 100K rijen en 10 kolommen. Alle bestanden staan in dezelfde folder.

Opmerking: We gaan voor deze oplossing met een klassieke lijst werken en niet met een tabel. Zie blog 2 in deze reeks in verband met data naar een tabel kopiëren.

Eerst bereid je de code voor om alle bestanden uit een folder te overlopen. De bestanden worden hierbij nog niet geopend, enkel hun naam wordt in onze variabele gestopt. De naam van elk bestand geef je weer in het ‘venster direct’ (Debug Window) of je kiest voor een ‘messagebox’. Als de lus werkt, voer je de dataoverdracht toe aan de code.

Sub GetDataFromFiles()
    Dim fldr As FileDialog
    Dim strPath As String
    Dim myFolder As String
    Dim myFile As String
    strPath = "C:\Xylos\BLOG\"          ' Dialog will start from this folder
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)    ' Select Folder, do not open folder
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False       ' Select only 1 folder
        .InitialFileName = strPath      ' Folder location
        If .Show <> -1 Then Exit Sub    ' Quit when user cancels
        myFolder = .SelectedItems(1)
    End With
    myFile = Dir(myFolder & "\*.xlsb")
    Do While myFile <> ""
        Debug.Print myFile
        myFile = Dir()  ' Get Next File
    Loop
End Sub

Hou er rekening mee dat het dialoogvenster dient om een folder aan te wijzen. Je mag niet dubbelklikken om de inhoud van de folder te tonen. Duid de juiste folder aan en bevestig met ‘OK’.

Tip: Met bovenstaand voorbeeld wordt de naam van elke aanwezige file in de folder in het ‘Venster Direct’ (Immediate Window) getoond door de opdracht ‘Debug.print’. Als het venster niet open staat kan je het zichtbaar maken met de sneltoets ‘CTRL+G’.

Nu kan je de code toevoegen die elke file beurtelings opent, de data kopieert en naar het doelbestand overbrengt.

Je start hierbij best met de klassieke methode waarbij een bestand geopend, gelezen en gesloten wordt via het ‘workbook’ object.

De aangepaste code:

Sub GetDataFromFiles()
    Dim fldr As FileDialog
    Dim strPath As String
    Dim myFolder As String
    Dim myFile As String
    Dim wbMain As Workbook
    Dim wsMain As Worksheet
    Dim wbData As Workbook
    Dim wsData As Worksheet
    Dim lngPasteRow As Long
    strPath = "C:\Xylos\BLOG\"          ' Dialog will start from this folder
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)    ' Select Folder, do not open folder
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False       ' Select only 1 folder
        .InitialFileName = strPath      ' Folder location
        If .Show <> -1 Then Exit Sub    ' Quit when user cancels
        myFolder = .SelectedItems(1)
    End With
    Application.ScreenUpdating = False
    Debug.Print Now
    myFile = Dir(myFolder & "\*.xlsb")
    Set wbMain = ActiveWorkbook
    Set wsMain = ActiveSheet
    lngPasteRow = 2
    Do While myFile <> ""
        Set wbData = Workbooks.Open(myFolder & "\" & myFile)
        Set wsData = wbData.Sheets(1)
        wsData.Cells(1, 1).CurrentRegion.Copy wsMain.Cells(lngPasteRow, 1)
        Set wsData = Nothing
        wbData.Close False
        lngPasteRow = wsMain.Cells(1, 1).End(xlDown).Row
        myFile = Dir()  ' Get Next File
    Loop
    Application.ScreenUpdating = True
    Debug.Print Now
End Sub

Deze code wordt in ongeveer 8 seconden uitgevoerd. Zonder gebruik te maken van ‘screenupdating’ duurt het langer en zie je elk bestand afzonderlijk geopend worden, wat een knipperend scherm als gevolg heeft.

In het volgende voorbeeld gaan we opnieuw gebruik maken van recordsets zoals we in de vorige blog uit deze reeks geleerd hebben.

Sub GetDataFromFiles()
    Dim fldr As FileDialog
    Dim strPath As String
    Dim myFolder As String
    Dim myFile As String
    Dim wbMain As Workbook
    Dim wsMain As Worksheet
    Dim wbData As Workbook
    Dim wsData As Worksheet
    Dim lngPasteRow As Long
    ' New variables
    Dim myConnection As String
    Dim RS As ADODB.Recordset
    Dim mySQL As String
    Application.ScreenUpdating = False
    strPath = "C:\Xylos\BLOG\"          ' Dialog will start from this folder
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)    ' Select Folder, do not open folder
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False       ' Select only 1 folder
        .InitialFileName = strPath      ' Folder location
        If .Show <> -1 Then Exit Sub    ' Quit when user cancels
        myFolder = .SelectedItems(1)
    End With
    Application.ScreenUpdating = False
    Debug.Print Now
    myFile = Dir(myFolder & "\*.xlsb")
    Set wbMain = ActiveWorkbook
    Set wsMain = ActiveSheet
    lngPasteRow = 2
    Do While myFile <> ""
         myConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & myFolder & "\" & myFile & ";Extended Properties=Excel 12.0"
        mySQL = "SELECT * FROM [Sheet1$]"
        Set RS = New ADODB.Recordset
        RS.Open mySQL, myConnection, adOpenForwardOnly, adLockOptimistic
        wsMain.Cells(lngPasteRow, 1).CopyFromRecordset RS
        RS.Close
        Set RS = Nothing
        lngPasteRow = wsMain.Cells(1, 1).End(xlDown).Row
        myFile = Dir()  ' Get Next File
    Loop
    Application.ScreenUpdating = True
    Debug.Print Now
End Sub

De uitvoertijd van deze code is nu tot 4 seconden verminderd. De methode levert dus een zeer interessante snelheidswinst op bij het uitlezen van een hele reeks bestanden.

Volgende blogpost: Een recordset maken, gebaseerd op data uit 2 verschillende worksheets (7/7).

Heb je na het lezen van deze blogpost de Excel- of zelfs de Power BI-microbe te pakken? Bekijk dan zeker ons aanbod open Excel-opleidingen en wie weet zien we je binnenkort in Antwerpen of Brussel.

Deel dit blogbericht
Categorieën: Excel
Tags: Excel

Also interesting for you

Laat een antwoord achter

Uw e-mailadres wordt niet gepubliceerd. Verplichte velden zijn gemarkeerd.

Breng jouw kennis en skills naar een hoger niveau

Schrijf nu in voor onze nieuwsbrief en krijg maandelijks:

  • Exclusieve tips & tricks
  • Informatie over onze opleidingen
  • Trends in opleidingen
  • Uitnodigingen voor studiedagen en events

Meest gekozen opleidingen