使用VBA将CSV导入Excel

时间:2017-12-20 15:26:06

标签: excel-vba csv vba excel

我们使用Revit文件中的Python创建CSV文件。我尝试使用VBA代码将CSV导入Excel。

projectinfo(data_fill = 8)正常运行。 然后我在Excel中导入了其他7个CSV。但是发生的事情是我的墙(wanden_data / data_fill = 1)en floor(vloeren_data / data_fill = 2)CSV首先在列A之前插入列,其他CSV从单元格A5中复制OK ...

有人可以解释会发生什么吗?我能做些什么呢?所有7个CSV都使用相同的代码...

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

截图Excel:

清空Excel表格: Image1

正确导入: Image2

错误导入: Image3

0 个答案:

没有答案