ray88’s diary

お仕事で困ったとき用の自分用の覚書

ExcelVBA CSVファイル→Excelファイルへ変換

CSVExcelへ変換するには、ただ単にファイル拡張子の変更して保存するっていう方法をとる人もいますが、
 それですとデータ上よくないこともありそうなので(数値の先頭の0が欠けるとか)、一旦テキストファイルを読み取ってExcelへ書き込む形式で変換
■呼び出し元プロシージャ

Option Explicit
 
Public Sub createExcelFileTest()
'---------------------------------------------------
'CSVを読込んでExcelファイルを作成する
'Excelファイルは「yyyyMMddhhmmss.xlsx」で作成される
'---------------------------------------------------
    Dim csvBookPath As String
    Dim dstFolderPath As String
    Dim ExcelFilePath As String
    Dim newBook As Workbook
    Dim strFileMakeTime As String
    
    'Excelファイル格納フォルダパス
    dstFolderPath = ThisWorkbook.Path
    
   '読み取り対象CSVファイルパス
    csvBookPath = "C:\Users\デスクトップ\テスト.csv"
        
    Debug.Print Format(Now(), "yyyymmddHHmmss")
    
    'ファイル名に使用する「yyyymmddHHmmss」形式の日時を取得
    strFileMakeTime = Format(Now(), "yyyymmddHHmmss")
    
    'Excel変換後のファイル名を指定
    ExcelFilePath = dstFolderPath & "\" & strFileMakeTime & ".xlsx"
        
    '指定したパスにファイルが作成済でないかを確認。
    If Dir(ExcelFilePath) = "" Then
        '新しいファイルを作成
        Set newBook = Workbooks.Add
        
        '新しいファイルをExcelファイル格納先フォルダパスへ保存
        newBook.SaveAs ExcelFilePath
        '作成したExcelファイルを一旦閉じる
        newBook.Close
    Else
        '既に同名のファイルが存在する場合はメッセージを表示
        MsgBox "既に" & ExcelFilePath & "というファイルは存在します。"
    End If
    'CSV→Excel変換
    Call procConvertExcel(csvBookPath, ExcelFilePath)
    
End Sub

■ファンクションプロシージャ

Sub procConvertExcel(CsvFilePath As String, ExcelFilePath As String)
'-----------------------------------------------------------------
'機能:指定されたCSVファイルを読込、Excel形式のファイルを作成する
'引数1:CSVファイルパス
'引数2:Excelファイルパス(読み込んだCSVの出力先Excelファイルパス)
'-----------------------------------------------------------------

Dim dataArray As Variant
Dim dataSet(0 To 300, 0 To 11) As Variant   'Rowはデータが溢れないように多めに設定。Columnは列数分用意
Dim wb As Workbook
Dim buf As String
Dim intFileNumber
Dim intIndex As Long
Dim i As Long

'ファイル番号を取得
intFileNumber = FreeFile

'読込モードでファイルを開く
Open CsvFilePath For Input As #intFileNumber

  '行インデックス番号を初期化
  intIndex = 0

  'ファイルの最後まで繰り返し
  Do Until EOF(intFileNumber)
       '1行分読み取り
       Line Input #intFileNumber, buf
       '1行分のデータをカンマ区切りで配列に格納
       dataArray = Split(buf, ",")
       'バリアント型の2次元配列に1行分のデータを格納
       For i = 0 To UBound(dataArray)
            dataSet(intIndex, i) = dataArray(i)
       Next
       
        '先頭行(項目名)以外ならログ出力
       If intIndex <> 0 Then
            'ためしに3列目の値のみまでログ出力
           Debug.Print intIndex & "行目:" & dataArray(0) & " :" & dataArray(1) & " :" & dataArray(2)
       End If
       
    '行インデックスに1足す
      intIndex = intIndex + 1
 Loop

  'CSVファイルを閉じる
  Close #intFileNumber
  
  'CSVより取得した内容をExcelに貼り付ける
  Set wb = Workbooks.Open(ExcelFilePath)
  With wb.Sheets("Sheet1")
    .Select
    .Range("A1:K300") = dataSet
  End With
  
  wb.Close True
  Set wb = Nothing
  
End Sub