Excel-VBAマクロ。テキストを含む複数の.csvファイルを列に変換してファイルをxlsxに保存します

Question

基本的には、テキスト付きの.csvファイルのバッチを列に変換する必要があり、ファイルを.xlsxにポスト "、"区切りに変換する必要があります。

現在、サンプルコードがありますが、ドットを1回クリックするだけで接続できます。

Option Explicit 

Sub OpenCSV() 

    Dim fd As FileDialog 

    Set fd = Application.FileDialog(msoFileDialogFilePicker) 
    fd.AllowMultiSelect = True 
    fd.Show 

    For Each fileItem In fd.SelectedItems 

     Workbooks.OpenText Filename:= _ 
          fileItem _ 
          , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
          xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ 
          Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True 

    Next 

End Sub 

Sub OpenCSVFolder() 

    Dim fd As FileDialog 

    Set fd = Application.FileDialog(msoFileDialogFolderPicker) 

    fd.AllowMultiSelect = True 
    fd.Show 

    For Each folderItem In fd.SelectedItems 

     fileItem = Dir(folderItem & "\" & "*.csv") 

     While fileItem <> "" 

      Workbooks.OpenText Filename:= _ 
           folderItem & "\" & fileItem _ 
           , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
           xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ 
           Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True 
      fileItem = Dir 

     Wend 

    Next 

End Sub 

Sub CSVtoXLS() 

    'UpdatebyExtendoffice20170814 
    Dim xFd As FileDialog 
    Dim xSPath As String 
    Dim xCSVFile As String 
    Dim xWsheet As String 

    Application.DisplayAlerts = False 
    Application.StatusBar = True 

    xWsheet = ActiveWorkbook.Name 

    Set xFd = Application.FileDialog(msoFileDialogFolderPicker) 
    xFd.Title = "Select a folder:" 

    If xFd.Show = -1 Then 
     xSPath = xFd.SelectedItems(1) 
    Else 
     Exit Sub 
    End If 

    If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\" 

    xCSVFile = Dir(xSPath & "*.csv") 

    Do While xCSVFile <> "" 

     Application.StatusBar = "Converting: " & xCSVFile 
     Workbooks.Open Filename:=xSPath & xCSVFile 
     ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xls", vbTextCompare), xlNormal 
     ActiveWorkbook.Close 
     Windows(xWsheet).Activate 
     xCSVFile = Dir 
    Loop 

    Application.StatusBar = False 
    Application.DisplayAlerts = True 

End Sub 

Answer 1

第2の手順は私のために働いています。

ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), FileFormat:=51 

"、"をシステム内の区切り文字として設定する必要があります。 EDIT：

偶然、あなたがした.csvファイルとは異なるデフォルトの区切り文字を持っていた、する場合は、このコードを使用してループを埋めることができます：

Dim qT As QueryTable 
Dim newWb As Workbook 
Dim sFileName As String 

Do While xCSVFile <> "" 

    Application.StatusBar = "Converting: " & xCSVFile 
    Set newWb = Application.Workbooks.Add 
    sFileName = Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare) 
    Set qT = newWb.Worksheets(1).QueryTables.Add(Connection:="TEXT;" & _ 
     xSPath & xCSVFile, Destination:=newWb.Worksheets(1).Range("A1")) 
    With qT 
     .FieldNames = True 
     .TextFileStartRow = 1 
     .TextFileParseType = xlDelimited 
     .TextFileOtherDelimiter = "," 'set your delimiter here 
     .Refresh 
    End With 
    newWb.SaveAs sFileName, FileFormat:=51 
    newWb.Close 
    xCSVFile = Dir 
Loop 

私は、これはGoogleの訪問者のために有用かもしれないと思う