CSVファイル読込 No.1

Sub InportCsv()
  Dim fso As Object
  Dim ts As Object
  Dim ws As Worksheet
  Dim tFilePath As String
  Dim dataArray As Variant
  Dim r As Integer, c As Integer
  Dim eData As Variant
  Dim fileName As Variant
  fileName = False
  
  Set ws = ThisWorkbook.Worksheets("データ")
  ws.Cells.Clear
  
  'ダイアログにてファイル取得
  fileName = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
  
  '取得できた場合
  If fileName <> False Then
    tFilePath = fileName
  
  '取得不可の場合は終了
  Else
    MsgBox "ファイルを選択してください"
    Exit Sub
  End If
   
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set ts = fso.OpenTextFile(tFilePath, 1)
  
  
  '読込位置のカーソル移動(1行目を取得したくない場合)
'  ts.SkipLine

  r = 2
  'シート「データ」に書き込み
  With ws
    'ファイルカーソルが末尾直前まで繰り返し
    Do Until ts.AtEndOfStream
      '1行ずつ読込、「,」で区切って配列格納
      dataArray = Split(ts.ReadLine, ",")
      
      '配列をセルに書き込み
      c = 2
      For Each eData In dataArray
        .Cells(r, c).Value = eData
        c = c + 1
      Next eData
      r = r + 1
    Loop
    
    '配列の初期化
    Erase dataArray
  End With
  ts.Close
  Set ts = Nothing
  Set fso = Nothing
  Set ws = Nothing
  MsgBox "完了"
  
End Sub

コメント