excel中導入csv

Question

編輯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)