Excel2003でマクロを使用してtxt取り込み

Question

エクセルでマクロを使用して、複数のtxtファイルを取り込みたいのですが
うまくいかず困っております。
過去の質問を見ながらやりたい事に近い下記のサンプルマクロを見つけました。

サンプルマクロ--------------------------------------------------------
Sub txt取り込み()
    Dim OpenFileName As Variant
    OpenFileName = Application.GetOpenFilename(FileFilter:="テキスト,*.txt?", _
     MultiSelect:=True)
    If IsArray(OpenFileName) Then
        ''''
    Else
        MsgBox "キャンセルしました、OKを押してください"
    End If
End Sub
-------------------------------------------------------------------
これだけでは、マクロ実行→ダイアログボックスでtxtFile選択。で終わってしまいます。
ここから下記の「txtFile内容説明」ご参照のうえ、以下の「手順」でtxt取込み出来る様、
ご教授いただけませんでしょうか?

「txtFile内容説明」---------------------------------------------
・ダイアログボックスで選択したいテキストファイルは最大100個です
・テキストファイルには、カンマで区切られたデータが保存されております

テキストファイル例(ファイル名は001.txtから連番で100.txt)
　001.txt→"001","A001","B","C",
　002.txt→"002","A002","B","C",
　003.txt→"003","A003","B","C",
　　．
　　．
　　．
　100.txt→"100","A100","B","C",

「txtFile内容説明」ココまで---------------------------------------

「手順」----------------------------------------------------------------------
(1)ダイアログボックスでテキストファイル複数選択(テキストファイル100個選択したとして)
(2)セルR3:R102(R3に001.txt R4に002.txt　R5に003.txt … R102に100.txt)を読み込み
(3)それぞれのテキストファイルをカンマ区切りで、右セルに区切って取り込み

セル配置
　R3　　　　S3　　　　T3　　　　U3
　R4　　　　S4　　　　T4　　　　U4
　R5　　　　S5　　　　T5　　　　U5
　　．
　　．
　　．
　R102　　S102　 　T102　 　U102

上記、セル配置に取り込まれたデータ
　001　　　A001　　 　B　　 　　C
　002　　　A002　 　　B　　 　　C
　003　　　A003　　 　B　　 　　C
　　．
　　．
　　．
　100　　　A100　　 　B　　 　　C

と、なるようにマクロを作成することは可能でしょうか?
その場合、どのような記述になるのか教えていただければ幸いです。

「手順」ココまで-------------------------------------------------------------

予備情報
説明の為、テキストファイル内データを、"003","A003","B","C",と、4データにしておりますが、
実際は16データあり、さらに1データの文字数は10ケタあります。
実際に16データ、文字数10ケタで質問説明を書いたのですが、あまりにわかりにくくなってしまい、
4データとして、文字数も絞らせていただき、質問致しました。
申し訳ございません。
なお、100個のテキストファイルを読み込ませ、セル範囲R3:AG102にデータテーブルを作りたいと
考えております。

説明不足な点ございましたら、ご指摘いただけますでしょうか。
何卒、よろしくお願い致します。

keithin · Accepted Answer

sub macro1()
　dim filenames as variant
　dim myfile as variant
　dim buf as string
　dim n

filenames = application.getopenfilename(multiselect:=true)
　if not isarray(filenames) then exit sub
　n = 2

for each myfile in filenames
　　n = n + 1
　　open myfile for input as #1
　　line input #1, buf
　　cells(n, "R") = buf
　　close #1
　next

Range("R3:R102").TextToColumns _
　　Destination:=Range("R3"), _
　　DataType:=xlDelimited, _
　　TextQualifier:=xlDoubleQuote, _
　　ConsecutiveDelimiter:=False, _
　　Tab:=False, _
　　Semicolon:=False, _
　　Comma:=True, _
　　Space:=False, _
　　Other:=False, _
　　FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), _
　　　Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), _
　　　Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), _
　　　Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2)), _
　　TrailingMinusNumbers:=True
end sub

ホンモノの実データの内容に応じて，チューニングが必要かもしれません。

Excel2003でマクロを使用してtxt取り込み

sub macro1()

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング