在excel中导入csv
编辑14五月
经过大量的阅读，我终于明白了VBA的基础知识。 我已经创build了下面的macros，但它仍然不工作，它不会插入CSV文件。 这个macros完成后，保存的文件都是空的。 用debug.print我确认了这个文件的string是完整的，但是还是有东西丢失了？
任何人都可以帮我解决这个问题
提前致谢
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 只要打开.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)