13
Dec
Verschillende CSV bestanden samenvoegen tot 1 bestand met VBA en Excel
Er zijn meerdere redenen te bedenken waarom je verschillende csv (kommagescheiden) bestanden samen wilt voegen tot 1 bestand. CSV bestanden kom ik nog met enige regelmaat tegen in allerlei software. De populariteit is aan het afnemen maar daar waar gebruikers geen kennis hebben van XML of JSON is deze manier van import en export een goed alternatief.
Bij een van onze klanten is de situatie dat men op verschillende locaties werkt waar geen onderling netwerk is opgezet. Eigenlijk is de reden heel simpel: de behoefte aan een netwerk is alleen aanwezig omdat men de productiegegevens 1 keer per dag wil uitwisselen. Om op de kosten van een netwerk te besparen hebben we een functie gemaakt waarmee de 25 bestanden automatisch worden samengevoegd tot 1 enkel CSV bestand. Dit scheelt 24 handelingen per dag.
Deze oplossing hebben we gratis gemaakt om de reden dat ik er een blog over wilde schrijven. Waarom niet op de achtergrond met een stukje code de CSV bestanden samenvoegen? Ook hiervoor is de reden net zo simpel: men wil eerst de input controleren voordat het een ERP wordt ingeschoten.
Hulp nodig bij dit onderwerp? Neem contact op met onze helpdesk en we helpen je graag op weg.
VBA de oplossing
Wederom is er VBA nodig om de CSV bestanden in Excel samen te voegen tot 1 enkel bestand.
Ik gebruik in dit blog de VBA sub [DoTheJob] waarin 2 verschillende subs en 1 functie worden aangeroepen. Als je het voorbeeldbestand hebt gekopieerd naar je eigen pc of server, pas dan in deze sub eerst de pad verwijzing van de variabele [sFolderName] aan.
Option Explicit Private sFolderName As String Private sOutputName As String Public Sub DoTheJob() 'pad variabelen sOutputName = "samengevoegd.csv" sFolderName = "D:\Development\Web\blog" RemoveOutput ReadCSV Dim sComplete As String sComplete = sFolderName & "\" & sOutputName Dim b As Boolean b = ImportResult(sComplete, 1) End Sub
Eerst verwijderen we het samengevoegde bestand als dat al bestaat. Dit doen we door de sub RemoveOutput aan te roepen.
Public Sub RemoveOutput() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object 'Create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'Get the folder object Set objFolder = objFSO.GetFolder(sFolderName) On Error Resume Next objFSO.DeleteFile (sFolderName & "\" & sOutputName) End Sub
Vervolgens lus ik alle bestanden in de folder [sFolderName] en voeg deze samen tot 1 nieuw bestand. Deze sub lust de CSV bestanden en opent deze 1 voor 1. De data uit het bestand wordt toegevoegd aan het nieuwe bestand [samengevoegd.csv].
Wil je het echt mooi maken? Dan zou je met het FileSystemObject de bestanden kunnen verplaatsen naar een nieuwe map, zodat je niet per ongeluk dezelfde bestanden nogmaals samenvoegt.
Public Sub ReadCSV() 'variabelen voor het uitlezen van de folder Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim i As Integer 'variabelen voor het samenvoegen 'Open de outputfile om de data toe te kunnen voegen Dim sWholefile As String Dim l As Long Dim l1 As Long l = FreeFile Open sOutputName For Output Access Write As #l On Error GoTo no_files 'Create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'Get the folder object Set objFolder = objFSO.GetFolder(sFolderName) 'lus de bestanden in de folder For Each objFile In objFolder.Files l1 = FreeFile Open objFile.Name For Input Access Read As #l1 sWholefile = Input$(LOF(l1) - 2, #l1) Print #l, sWholefile Close #l1 Next objFile no_files: Close #l1 Close #l End Sub
Tot slot importeer ik de data uit het samengevoegde bestand met de VBA functie [ImportResult] weer terug in het werkblad op de muispositie.
Denk eraan dat je de parameters van de importfunctie aanpast naargelang de opmaak van je CSV bestand. In de voorbeeldbestanden is het scheidingsteken een punt-komma ; en zijn er geen quotes geplaatst om de tekst.
Public Function ImportResult(pCsvBestand As String, pStartRow As Integer) Range("A65536").End(xlUp).Offset(1, 0).Select 'naar lege rij ' ActiveCell.Rows.Address geeft verwijzingstype A1 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & pCsvBestand, Destination:=Range(ActiveCell.Rows.Address)) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 850 .TextFileStartRow = pStartRow 'bij kopregels soms overslaan .TextFileParseType = xlDelimited 'xlTextQualifierDoubleQuote voor "" 'xlTextQualifierSingleQuote voor '' .TextFileTextQualifier = xlTextQualifierNone 'De tekst in dit voorbeeld staat niet tussen quotes " " .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = False .TextFileSemicolonDelimiter = True 'Scheidingstekens in dit voorbeeld is een punt/komma ; .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With ImportResult = True End Function
