在excel中导入csv

Question

5 月 14 日编辑

经过大量阅读，我终于了解了 VBA 的基础知识。我在下面创建了宏，但它仍然无法正常工作，它不会插入 csv 文件。 此宏完成后，保存的文件全部为空。使用 debug.print 我确认文件的字符串是完整的，但仍然缺少一些东西？

谁能帮我解决这个问题

提前致谢

Sub CSVimporterennaarxlsx()
    'On Error Resume Next
    'declare variable
    Application.ScreenUpdating = False
    Dim strpath As String
    Dim fmn As Integer
    Dim lmn As Integer
    Dim csvname As String
    Dim strpathcsvname As String
    'active workbook pathway
    strpath = Application.ActiveWorkbook.Path
    'ask user for first and last number
    fmn = InputBox("first mouse number")
    lmn = InputBox("last mouse number")
    'einde sub if inputbox is empty
'    If fmn = "" Then
'    MsgBox "No first mouse number"
'    Exit Sub
'    End If
'    If lmn = "" Then
'    MsgBox "No Last mouse number"
'    Exit Sub
'    End If

    'assign variables

    'loop all the files
     For fmn = fmn To lmn
     csvname = "m" & fmn
     strpathcsvname = strpath & "\" & csvname & ".csv"
     'input of csv file
'        ActiveSheet.Cells.Delete

        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" + strpathcsvname, _
            Destination:=Range(A1))
'filename without extension
            .Name = csvname
            .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 = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
            , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1, 1)
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = ","
            .TextFileTrailingMinusNumbers = True
        End With
    Call CsvToXlsx(ByVal csvname, strpath)
    Next fmn
Application.DisplayAlerts = True
    End Sub

    Sub CsvToXlsx(ByVal csvname, strpath)
    ChDir (strpath & "/verwerkt")
     Application.DisplayAlerts = False
    csvname = csvname & ".xlsx"
      ActiveWorkbook.SaveAs Filename:=csvname, FileFormat:=51

    End Sub

Answer 1

尝试打开.csv 文件并将其保存为.xls 文件

Sub CsvToXls (csvname)
  Workbooks.Open Filename:=csvname
  xlsname = Replace(csvname, ".csv",".xls")  
  ActiveWorkbook.SaveAs Filename:=xlsname , FileFormat:=xlNormal
End Sub

然后，迭代一个目录中的所有.csv 文件

Sub AllCsvToXls(dirname)        
    Dim csv As Variant 
    csv = Dir(dirname & "\*.csv")
    While (csv <> "")
      CsvToXls (dirname & "\" & csv)
      csv = Dir
    Wend  
End Sub

最后，调用它...

AllCsvToXls(ThisWorkbook.Path)