ポイント
- CSV 形式のファイル、つまりカンマで区切られたデータのファイルを読み込むことができる。ファイル拡張子が .csv でなくても読み込める。
- 必ずテキスト形式でインポートされるように TextFileColumnDataTypes に指定する配列の作り方を工夫した。
- コネクションは生成されたものだけ削除するように改善した。
- Name オブジェクトの削除方法を改善し、シート名に影響を受けないようにした。
- 他のエクセルなどからも呼び出せるようにブック名を指名するようにした。
読み込まれる CSV ファイル
これは前回と同じです。
1 2 3 4 | No,氏名,電話番号 1,伊藤健一,0112223333 2,高橋哲也,0114445555 3,佐藤誠,0116667777 |
VBA コード
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 | ''' <summary> ''' CSV ファイルを指定ブックのシートにインポートするクラスです。 ''' エクセルへはテキスト形式で書き込みます。 ''' </summary> Option Explicit Private mstrCsvFilePath As String Private mstrBook As String Private mobjSheet As Worksheet Private mstrStartCell As String Private mstrAutoCreatedName As String ''' <summary> ''' コンストラクタ ''' </summary> Private Sub Class_Initialize() ' インポート時にセル範囲に付く「名前」 ' 既存の Name オブジェクトと重複しないよう、年月日時分秒の文字列を末尾に付加 Dim strSalt as String : strSalt = Format(Now, "yyyymmddhhnnss" ) mstrAutoCreatedName = "CsvImporterName" & strSalt End Sub ''' <summary> ''' 初期化処理を実行します。 ''' </summary> ''' <param name="strCsvFilePath">CSV ファイルフルパス</param> ''' <param name="strBook">書き込み対象ブック名</param> ''' <param name="strSheet">書き込み対象ワークシート名</param> ''' <param name="strStartCell">インポート開始セル名</param> Public Sub Init( _ ByVal strCsvFilePath as String , _ ByVal strBook as String , _ ByVal strSheet As String , _ ByVal strStartCell As String ) ' 変数をセット mstrCsvFilePath = strCsvFilePath Set mobjSheet = Workbooks(strBook).Sheets(strSheet) mstrStartCell = strStartCell End Function ''' <summary> ''' CSV ファイルを読み込み、ワークシートに書き込みます。 ''' </summary> Public Sub Import() ' ファイルの各列に適用されるデータ型をテキスト形式のみに指定 Dim vntColDataTypes() As Variant , i As Long : ReDim vntColDataTypes(Column.Count) For i = 0 To Column.Count: vntColDataTypes(i) = xlTextFormat: Next i ' ファイル読み込み、および、書き込み With mobjSheet.QueryTables.Add( _ Connection:= "Text;" & mstrCsvFilePath, _ Destination:=mobjSheet.Range(mstrStartCell)) .Name = mstrAutoCreatedName .RowNumbers = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .RefreshPeriod = 0 .TextFilePlatform = 932 .TextFileCommaDelimiter = True .TextFileColumnDataTypes = vntColDataTypes .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:= False Dim strConName As String : strConName = .WorkbookConnection.Name End With ' 後処理。作成されるコネクションと Name オブジェクトを削除 Call DeleteConnection(mstrBook, strConName) Call DeleteName(mstrBook, mstrAutoCreatedName) End Sub ''' <summary> ''' 指定したコネクションを削除します。 ''' </summary> ''' <param name="strBook">ブック名文字列</param> ''' <param name="strConName">コネクション名文字列</param> Private Sub DeleteConnection( _ ByVal strBook As String , _ ByVal strConName As String ) Workbooks(strBook).Connections(strConName).Delete End Sub ''' <summary> ''' 指定した名前 (Name オブジェクト) を削除します。 ''' </summary> ''' <param name="strBook">ブック名文字列</param> ''' <param name="strName">名前 (Name オブジェクト) 文字列</param> Private Sub DeleteName( _ ByVal strBook As String , _ ByVal strName As String ) ' シート名が [Sheet1!] など ! を含む場合、Name を指定しての削除ができずエラーとなった。 ' よって、Name に対応する Index を取得し、Index を指定して削除する。 ' 削除対象の Name オブジェクトを特定 Dim colIndexes As Collection: Set colIndexes = New Collection Dim vntItem As Variant For Each vntItem In Workbooks(strBook).Names If vntItem.Name Like "*" & strName & "*" Then Call colIndexes.Add(vntItem.Index) End If Next vntItem ' 特定した Name オブジェクトを削除 Dim vntIndex As Variant For Each vntIndex In colIndexes Workbooks(strBook).Names.Item(vntIndex).Delete Next vntIndex End Sub |
続いては上記のクラスを確認するコードです。CSV のインポート先は VBA のエクセルファイル自身としています。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | Option Explicit 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 ' CSV インポート Dim udtCi As CsvImporter: Set udtCi = New CsvImporter Call udtCi.Init(strCsvFilePath, "VbaCsvImporter.xlsm" "Sheet1" , "A1" ) Call udtCi.Import End Sub |
おわりに
参考ページです。ありがとう存じます!
- ExcelでCSVをそのまま開く – @jitteの日記
- 【Excel VBA】CSV ファイルをワークシートにインポートするクラスのコード♪ – oki2a24
- 【Excel VBA】配列の要素数に変数の数字を設定する方法 – oki2a24
以前の投稿のコードをベースにしましたけれども、タイポなどがあり直すこともできました。一石二鳥ですの♪
以上です。