CSVを読み込むVBA

自分用のメモ
CSVを読み込むVBAを記載

Sub Sample1()

Dim FileNum     As Long
Dim i           As Long
Dim n           As Long
Dim myStr()     As String
Dim myRec       As String
Dim FSO         As Object
Dim TargetFile  As String
Dim FileRow     As Long
Dim csvArray()  As Variant
Dim MaxCol      As Long

Dim templateFilePath As String
Dim thisBookPath As String




Application.ScreenUpdating = False '画面更新をOFF
Application.Calculation = xlManual '自動計算をOFF
Application.EnableEvents = False 'イベントをOFF

templateFilePath = "C:\イグナシオ\tatekae_template.xlsx"
thisBookPath = ThisWorkbook.Path

TargetFile = "C:\イグナシオ\input.csv"

Set FSO = CreateObject("Scripting.FileSystemObject")

'追加書き込みモードで開いて最終行番号を取得
With FSO.OpenTextFile(TargetFile, 8)

    FileRow = .Line
    .Close
    
End With

Set FSO = Nothing

FileNum = FreeFile

i = 0
MaxCol = 0

Open TargetFile For Input As #FileNum

'Range("A:F").NumberFormat = "@"

Do While Not EOF(FileNum)
    
    Line Input #FileNum, myRec
    
    myStr = Split(myRec, ",")
    
    'max要素数(カラム数)を取得
    If MaxCol < UBound(myStr) Then MaxCol = UBound(myStr)
    
    '配列の要素数を値を維持したまま再定義(0からcsvの最終行数,0から最大カラム数)
    ReDim Preserve csvArray(0 To FileRow, 0 To MaxCol)
    
    '配列にcsvの値を設定
    For n = 0 To UBound(myStr)
    
        csvArray(i, n) = myStr(n)
    
    Next n
    
    i = i + 1
    
Loop

Close #FileNum

Range(Cells(1, 1), Cells(FileRow + 1, MaxCol + 1)) = csvArray

Dim twb As Workbook

j = 21

Dim maxExcelFileCount As Integer
Dim fileRangeFrom As Integer
Dim fileRangeTo As Integer


If ((FileRow - 1) Mod 3) = 0 Then
maxExcelFileCount = (FileRow - 1) / 3
Else
maxExcelFileCount = WorksheetFunction.RoundDown((FileRow - 1) / 3, 0) + 1
End If

For m = 1 To maxExcelFileCount
    Set twb = Workbooks.Open(templateFilePath)
    fileRangeFrom = 1 + (m - 1) * 3
    fileRangeTo = fileRangeFrom + 2

'For n = 1 To UBound(csvArray, 1) - 1
For n = fileRangeFrom To fileRangeTo
    'Worksheets("template").Activate
    'Set twb = Workbooks.Open(templateFilePath)
    
    If n <= (UBound(csvArray, 1) - 1) Then
    
    Cells(j, 2) = csvArray(n, 0)
    Cells(j, 4) = csvArray(n, 1)
    If csvArray(n, 4) = 8 Then Cells(j, 11) = "※"
    Cells(j, 12) = csvArray(n, 2)
    Cells(j, 14) = csvArray(n, 3)
    
    End If


'「TEST1」シートを新しいブックへコピーする
    'ThisWorkbook.Worksheets("template").Copy
    
    '値削除
    'Range("B21:B23").Clear
    'Range("D21:D23").Clear
    'Range("K21:K23").Clear
    'Range("L21:L23").Clear
    'Range("O21:O23").Clear

    j = j + 1
Next n
    
    '新しく作成したブックを名前を付けて保存
    ActiveWorkbook.SaveAs Filename:=thisBookPath & "\TEST" & n & Format(Now(), "yyyymmddhhmmss") & ".xlsx"
    
    '新しく作成したブックを閉じる
    ActiveWorkbook.Close False
    
    j = 21
Next m

Application.ScreenUpdating = True '画面更新をON
Application.Calculation = xlAutomatic '自動計算をON
Application.EnableEvents = True 'イベントをON


End Sub

Sub openExcel()
Dim ExcelApp As New Application
Dim Wb As Workbook
Dim ReadFolderFullPath  As String

'開くExcelファイルを指定
ReadFolderFullPath = ThisWorkbook.Path & "\" & "Book1.xlsx"

'エクセルを不可視で開く
ExcelApp.Visible = False      'エクセル可視/不可視設定
ExcelApp.DisplayAlerts = False      '警告メッセージをオフ
Set Wb = ExcelApp.Workbooks.Open(ReadFolderFullPath)

ExcelApp.DisplayAlerts = True      '警告メッセージをオン
ExcelApp.Quit      'Excel終了
Set ExcelApp = Nothing      '参照を解放
End Sub

Sub selectFile()

    Dim FilePath
        
    'カレントディレクトリを設定します。
    With CreateObject("WScript.Shell")
        .CurrentDirectory = ThisWorkbook.Path
    End With
    
    'ファイルを指定するダイアログを表示します。
    FilePath = Application.GetOpenFilename("csvファイル,*.csv?")
    
    '設定しない場合は、終了します。
    If FilePath = False Then Exit Sub
    
    MsgBox FilePath
    
End Sub