Importeren CSV voegt 2x wel en 5x geen kolommen in

[Joete]

Vanuit Revit (Bouwkundig 3D modeleer programma) maken wij door middel van Python een aantal CSV bestanden (1x projectinfo, 7x modeldata/-dimensies). Nu wil ik deze importeren in een Excel bestand met VBA. Het importeren lukt, maar er gebeurd nog wel iets vreemds wat ik na een dag puzzelen nog niet voor elkaar kan krijgen.

In onderstaande code doe ik het volgende:

• Een aantal variabelen definieren
• De namen van de CSV bestanden in een array zetten
• Controleren of alle CSV bestanden bestaan
• Stoppen als ik onvoldoende CSV bestanden heb (ze worden in Python altijd allemaal aangemaakt)
• Mijn Excel werkbladen in een array stoppen
• Excel vullen met projectinfo uit de CSV (data_fill = 8)
• Excel vullen met de modeldata uit de CSV's

Tot zover geen problemen, alles komt in Excel te staan. Alleen wat nu het vreemde is, is dat bij mijn wanden en vloeren (data_fill 1 en 2) voor de opgemaakte tabel op het werkblad kolommen ingevoegd worden waar de data in gezet wordt (verkeerd), de overige imports (data_fill 3, 4, 5, 6 en 7) plaatst hij de info wel gewoon in de daarvoor bestemde cellen (zonder kolommen in te voegen).

Nu zit ik al anderhalve dag te klieren om e.e.a. aan te passen en gewoon in de daarvoor bestemde cellen te krijgen, maar ik krijg het niet voor elkaar... Iemand hier een oplossing voor? Het is hetzelfde script, de cellen die gevuld dienen te worden zijn leeg...

Zie ook bijgevoegde afbeeldingen (leeg, correct en fout)

Sub CSV_inladen()
    Dim StartTime As Double
    Dim SecondsElapsed As Double
    StartTime = Timer
    Dim File As String
    Dim teller As Integer
    teller = 0
    Dim Missers As String
    Missers = ""
    
    ' csv in array
    Dim CSV(1 To 8) As String
    ' csv bestanden vastleggen
    CSV(1) = "wanden_data"
    CSV(2) = "vloeren_data"
    CSV(3) = "plafonds_data"
    CSV(4) = "liggers_data"
    CSV(5) = "kolommen_data"
    CSV(6) = "daken_data"
    CSV(7) = "overige_data"
    CSV(8) = "projectinfo_data"
    
    ' Loopje voor het tellen en controleren
    For c = 1 To UBound(CSV)
        File = ThisWorkbook.Path & "\csv_bestanden\" & CSV(c) & "*.csv"
        Filename = Dir(File)
        If Filename <> "" Then
            teller = teller + 1
        Else
            Missers = Missers & Chr(13) & " - " & CSV(c) & ".csv"
        End If
    Next c
       
    ' controle of CSV bestanden bestaan
    If teller = 0 Then
        MsgBox "Geen CSV-bestanden gevonden. Zorg dat deze op de juiste manier aangemaakt worden.", vbCritical + vbOKOnly, "Geen data"
    ElseIf teller < UBound(CSV) Then
        MsgBox "Onvoldoende CSV-bestanden gevonden. Zorg dat deze op de juiste manier aangemaakt worden. De volgende CSV bestanden ontbreken:" & Missers, vbCritical + vbOKOnly, "Geen data"
    Else
        ' werkbladen in array
        Dim Sh(1 To 8) As String
        ' werkbladen vastleggen
        Sh(1) = "wanden_meetstaat"
        Sh(2) = "vloeren_meetstaat"
        Sh(3) = "plafonds_meetstaat"
        Sh(4) = "liggers_meetstaat"
        Sh(5) = "kolommen_meetstaat"
        Sh(6) = "daken_meetstaat"
        Sh(7) = "overige_categorien"
        Sh(8) = "meetstaat_instructie"
        
        For data_fill = 1 To UBound(Sh)
            ' werkblad en csv-bestand bepalen
            Set WS = ActiveWorkbook.Sheets(Sh(data_fill))
            csvFile = ThisWorkbook.Path & "\csv_bestanden\" & CSV(data_fill) & ".csv"
            
            ' excel vullen uit csv
            If data_fill = 8 Then
                With WS.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=WS.Range("F2"))
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .RefreshStyle = xlOverwriteCells
                    .SavePassword = False
                    .SaveData = False
                    .AdjustColumnWidth = False
                    .RefreshPeriod = 0
                    .TextFilePromptOnRefresh = False
                    .TextFilePlatform = 850
                    .TextFileStartRow = 1
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .TextFileConsecutiveDelimiter = False
                    .TextFileTabDelimiter = False
                    .TextFileSemicolonDelimiter = True
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = False
                    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
            Else
                With WS.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=WS.Range("A5"))
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    '.RefreshStyle = xlOverwriteCells
                    .SavePassword = False
                    .SaveData = False
                    .AdjustColumnWidth = False
                    .RefreshPeriod = 0
                    .TextFilePromptOnRefresh = False
                    .TextFilePlatform = 850
                    .TextFileStartRow = 1
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .TextFileConsecutiveDelimiter = False
                    .TextFileTabDelimiter = False
                    .TextFileSemicolonDelimiter = True
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = False
                    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
            End If
            ' querytables verwijderen
            On Error GoTo nothingtodelete
                Sheets(Sh(data_fill)).QueryTables(1).SaveData = False
                Sheets(Sh(data_fill)).QueryTables.Item(1).Delete
nothingtodelete:
        Next data_fill
        
        ' melding met verwerkte tijd
        SecondsElapsed = Round(Timer - StartTime, 2)
        MsgBox "Data toegevoegd in " & SecondsElapsed & " seconden", vbOKOnly + vbInformation, "Data toegevoegd"
    End If
End Sub

 

[VenA]

Lijkt mij lastig om er iets van te zeggen zonder de bestanden te zien.

Om een array te vullen zijn er betere methoden. Voor het binnenhalen van de data heb je ook maar 1 procedure nodig. Waarom gebruik je voor alle bestanden en bladnamen dezelfde prefix behalve voor de laatste?

Sub VenA()
  c00 = ThisWorkbook.Path & "\"
  ar = Split("test test")
  ar1 = Split("Sheet1 Sheet2")
    For j = 0 To UBound(ar)
      With Sheets(ar1(j))
        With .QueryTables.Add("TEXT;" & c00 & ar(j) & ".csv", IIf(j = 1, .Range("$F$5"), .Range("$A$2")))
          .RefreshStyle = xlOverwriteCells
          .SaveData = False
          .AdjustColumnWidth = False
          .TextFilePlatform = 850
          .TextFileParseType = xlDelimited
          .TextFileTextQualifier = xlTextQualifierDoubleQuote
          .TextFileSemicolonDelimiter = True
          .Refresh BackgroundQuery:=True
        End With
      End With
    Next j
End Sub

 

[Joete]

Bedankt voor het inzicht, heb de code nu een heeeeeel stuk kunnen inkorten.
De fout er hiermee niet uit kunnen krijgen.

Heb nu mijn excelbestand opnieuw gemaakt, macro's er in gekopieerd, opmaak opnieuw gemaakt en nu werkt het wel zoals het hoort. Ik denk dat de 2 betreffende werkbladen toch op de een of andere manier ergens vervuiling hebben gehad waardoor Excel bij het importeren het nodig vond om kolommen in te voegen...

Probleem is dus opgelost, de vraag waarom ik problemen had blijft alleen nog wel...

 

[snb]

Als je het bestand 1 keer maakt en daarin de querytables zet hoef je de volgende keer het bestand alleen maar te openen om de geactualiseerde gegevens te zien.
Dan heb je geen enkele macro meer nodig.

PS. er werden geen kolommen toegevoegd, de gegevens werden niet uitgesplitst naar kolommen en stonden dus alleen maar in kolom A.