カテゴリー
Microsoft

【Excel VBA】CSV ファイルをワークシートにインポートするクラスのコード♪

CSV ファイルのをエクセルにインポートする条件

  • CSV ファイルを VBA からエクセルにインポートしたい。
  • CSV の各項目にダブルクオーテーションが付いていてもいなくても、インポートできるようにしたい。
  • 読み込み先エクセルの列のデータ型、つまり表示形式を指定したい (先頭の 0 が自動的に除去されないように、などしたい) 。

読み込まれる CSV ファイル

連絡帳.csv
1
2
3
4
No,氏名,電話番号
1,伊藤健一,0112223333
2,高橋哲也,0114445555
3,佐藤誠,0116667777

VBA コード

  • クエリーテーブルを使用する方法で CSV をインポートしている。
  • クエリーテーブルを使用してインポートする場合、次の副作用、想定外の出来事、悪影響が発生する。
    • インポート対象 CSV ファイルとのコネクションが張られてしまう (エクセルで、データ > 接続、で確認可能のはず) 。これにより、エクセルに読み込んだデータを編集すると元データも同期されてしまう。
    • インポート範囲を対象に Name オブジェクトが作成されてしまう (エクセルので、数式 > 名前の管理、で確認可能) 。これといって害は無いと思う。
  • 副作用を取り除くために、インポート処理完了後に次の処理を行った。
    • コネクションはすべて削除するようにした。
    • Name オブジェクトは自動的に作成されたものを狙って削除するようにした。他にもセル範囲に名前をつけた Name オブジェクトが予め存在していたため。
  • 自動生成の Name オブジェクトは、名前を指定しても連続して CSV インポートを行うと接尾辞が付与された Name オブジェクトが追加されてしまう。これにより、指定した文字列で Name オブジェクトを削除できない場合がある。
  • そこで Name オブジェクトが生成されるときに接尾辞を予め付与することで自動付与の接尾辞を抑制した。接尾辞のフォーマットは、他の Name オブジェクトと重複しないよう yyyymmddhhnnss とした。
  • データの先頭に 0 がある場合、取り除かれてインポートされてしまう。そこで、TextFileColumnDataTypes で各列に適用されるデータ型を指定できるようにしている。
  • クエリーテーブルの各プロパティについて、必須かどうか、デフォルト値は何か、は調べていない。省略できるプロパティはあると思う。
  • TextFilePlatform の値は 932 で、これはマクロの記録で設定された値をそのまま使用している。公式ドキュメントのページを見ても、932 に該当する値は記載されていない。しかし次のページを見てみると正しい値と思うのでこのまま使用する。

CsvImporter.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
Option Explicit
 
Private mstrClassName As String
 
Private mobjTargetWorksheet As Worksheet
Private mstrCsvFilePath As String
Private mstrStartRange As String
Private mvntColumnDataTypeArray As Variant
Private mstrAutoCreatedName As String
 
''' <summary>
''' コンストラクタ
''' </summary>
Private Sub Class_Initialize()
    mstrClassName = TypeName(Me)
    Debug.Print (mstrClassName & " : Constructor is called.")
 
    ' インポート時にセル範囲に付く「名前」
    ' 既存の Name オブジェクトと重複しないよう、年月日時分秒の文字列を末尾に付加
    Dim strSalt as String
    strSalt = Format(Now, "yyyymmddhhnnss")
    mstrAutoCreatedName = "CSV取込" & strSalt
End Sub
 
''' <summary>
''' デストラクタ
''' </summary>
Private Sub Class_Terminate()
    Debug.Print (mstrClassName & " : Destructor is called.")
End Sub
 
''' <summary>
''' 初期化処理を実行します。
''' </summary>
''' <param name="strCsvFilePath">CSV ファイルフルパス</param>
''' <param name="strTargetWorksheet">書き込み対象ワークシート</param>
''' <param name="strStartRange">インポート開始セル名</param>
''' <param name="vntColumndataTypeArray">インポート形式を指定した配列 (QueryTable.TextFileColumnDataTypes プロパティ)</param>
Public Sub Init( _
  ByVal strCsvFilePath as String, _
  ByVal strTargetWorksheet As String, _
  ByVal strStartRange As String, _
  ByVal vntColumndataTypeArray As Variant)
 
    Debug.Print (mstrClassName & " : Init")
 
    ' 変数をセット
    mstrCsvFilePath = strCsvFilePath
    Set mobjTargetWorksheet = Worksheets(strTargetWorksheet)
    mstrStartRange = strStartRange
    mvntColumnDataTypeArray = vntColumndataTypeArray
End Sub
 
''' <summary>
''' CSV ファイルを読み込み、ワークシートに書き込みます。
''' </summary>
Public Sub Import()
  Debug.Print (mstrClassName & " : Import")
 
  ' ファイル読み込み、および、書き込み
  With mobjTargetWorksheet.QueryTables.Add( _
    Connection:="Text;" & mstrCsvFilePath, _
    Destination:=mobjTargetWorksheet.Range(mstrStartRange))
    .Name = mstrAutoCreatedName
    .RowNumbers = False
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .RefreshPeriod = 0
    .TextFilePlatform = 932
    .TextFileCommaDelimiter = True
    .TextFileColumnDataTypes = mvntColumnDataTypeArray
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
  End With
 
  ' 後処理。作成されるコネクションと Name オブジェクトを削除
  Call DeleteConnections
  Call DeleteAutoCreatedName
End Sub
 
''' <summary>
''' エクセルファイルに存在するコネクションを全て削除します。
''' </summary>
Private Sub DeleteConnections()
  Do While ActiveWorkbook.Connections.Count > 0
    ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
  Loop
End Sub
 
''' <summary>
''' インポート時に生成された名前 (Name オブジェクト) を削除します。
''' </summary>
Private Sub DeleteAutoCreatedName()
    ' 削除対象の Name オブジェクトを特定
    Dim colNames As Collection
    Set colNames = New Collection
    Dim vntItem As Variant
    For Each vntItem In ActiveWorkbook.Names
        If vntItem.Name Like "*" & mstrAutoCreatedName & "*" Then
            colNames.Add vntItem.Name
        End If
    Next vntItem
  
    ' 特定した Name オブジェクトを削除
    Dim vntName As Variant
    For Each vntName In colNames
        ActiveWorkbook.Names(vntName).Delete
    Next vntName
End Sub

続いて、上記のクラスを確認するコードです♪

ThisWorkbook.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
 
' CSV インポートクラスを使用したテストコード
Public Sub Test()
  ' 準備
  ' CSV ファイルパス取得
  Dim strCsvFilePath As String
  strCsvFilePath = Application.GetOpenfilename( _
    Filefilter:="CSVファイル(*.csv),*.csv", _
    Title:="CSVファイルの選択")
  If strCsvFilePath = "False" Then
    Debug.Print ("CSV ファイルが指定されなかったため、終了")
    End
  End If
  ' インポート表示形式 (3列目のみ文字列、それ以外は標準)
  Dim vntColumndataTypeArray As Variant
  vntColumndataTypeArray = Array(xlGeneralFormat, xlGeneralFormat, xlTextFormat)
 
  ' CSV インポート
  Dim udtCi As CsvImporter
  Set udtCi = New CsvImporter
  Call udtCi.Init(strCsvFilePath, "Sheet1", "A1", vntColumndataTypeArray)
  Call udtCi.Import
End Sub

おわりに

CSV を読み込む方法は 4 種類ほどあるそうですの。それぞれ参考ページを見ながら検討いたしました。

CSV ファイルはダブルクォーテーション「”」が付いており、これをエクセルで編集すると取り除かれてしまいます。

  • ダブルクオーテーションが付いていてもいなくても、インポートできるようにしたい。
  • 読み込み先エクセルの列のデータ型、つまり表示形式を指定したい。

以上の条件を満たし、プログラミング量も少なくて済みそうなやり方ということで、クエリーテーブルを使った方法を採用いたしました。

最後に、参考ページです。ありがとう存じます！

以上です。

コメントを残す