ブックをひらかずにテキストファイルを取り込む

質問

エクセルのブックを開かずにテキストファイルを取り込みたいのですが、対象のテキストファイルは
タブで分かれています。

本を見て
下記のプロシージャを使用したいのですが、
テキストが取り込まれるブックに郵便番号と言うシートを作成してもうまく取り込めません。

テキストはタブで区切られたテキストで　７列のデータです。
下記のものを開こうとすると、7列でデータが入るのですが、タブでデータが区切られてこないのです。
データが続いて一つのセルに入ってしまい、
うまく設定できません。
何がいけないのでしょうか？
宜しくお願いします。

Sub ReadTxt()
Dim myTxtFile As String
Dim myBuf(7) As String
Dim i As Integer, j As Integer

Application.ScreenUpdating = False

myTxtFile = ActiveWorkbook.Path & "\Fuji.txt"

Worksheets("郵便番号").Activate

Open myTxtFile For Input As #1

Do Until EOF(1)
Input #1, myBuf(1), myBuf(2), myBuf(3), myBuf(4), _
myBuf(5), myBuf(6), myBuf(7)

'データをセルに展開する
i = i + 1
For j = 1 To 7
Cells(i, j) = myBuf(j)
Next j
Loop

Close #1
End Sub

回答No.1

noname#29107 · ベストアンサー

INPUT文は、カンマ区切りの場合になります。
LINE INPUT で読み込んで、split関数で分けましょう。

Sub ReadTxt()
Dim myTxtFile As String
Dim myBuf As String, wkdt() As String
Dim i As Integer, j As Integer

Application.ScreenUpdating = False

myTxtFile = ActiveWorkbook.Path & "\Fuji.txt"

Worksheets("郵便番号").Activate

Open myTxtFile For Input As #1

Do Until EOF(1)
Line Input #1, myBuf

wkdt = Split(myBuf, vbTab)
'データをセルに展開する
i = i + 1
For j = 0 To UBound(wkdt)
Cells(i, j + 1) = wkdt(j)
Next j
Loop

Close #1
End Sub

補足

rebellionさん
アドバイス有難うございます。
早速やってみましたら、思い通りに開けるようになりました。

もう一つ質問させて頂きたいのですが、
もしお時間が有りましたら、教えてください。
"\Fuji.txt"テキストがブックと同じ場所に有るのですが、このテキスト名が日付で変る場合が有るのですが、日付+アルファベットでテキストを保存する予定です。日付をワイルドカードのように******_fuji.text
のようにしていして、日付がどの様に変っても_fujiの付いたファイルを開くようにすることは可能かご存知でしたら、アドバイスをお願いします。
よろしくおねがいします。

回答No.4

noname#29107

＃１です。
＞日付がどの様に変っても_fujiの付いたファイルを開くようにすることは可能か
Dir関数を使用すると条件に該当するファイル名を取り出すことが出来ます。例えば該当するファイルを全件展開するなら、以下のようにします。

Sub ReadTxt()
Dim myTxtFile As String
Dim myBuf As String, wkdt() As String
Dim i As Integer, j As Integer

'Application.ScreenUpdating = False
flmei = Dir(ActiveWorkbook.Path & "\??????_fuji.txt")
Worksheets("郵便番号").Activate
i = 0
Do While flmei <> ""
　　myTxtFile = ActiveWorkbook.Path & "\" & flmei
　　Open myTxtFile For Input As #1
　　Do Until EOF(1)
　　　　Line Input #1, myBuf
　　　　wkdt = Split(myBuf, vbTab)
　　　　'データをセルに展開する
　　　　i = i + 1
　　　　For j = 0 To UBound(wkdt)
　　　　　　Cells(i, j + 1) = wkdt(j)
　　　　Next j
　　Loop
　　Close #1
　　flmei = Dir()
Loop
End Sub

最新のファイルだけ取り込みたいという条件なら、ユーザーにファイルを選ばせるとか、処理済みのファイルをシート上に保存しておくなどの方法が考えられます。しかし、補足の内容では条件が絞り切れません。

あと Application.ScreenUpdating = False
などは、動作確認が済むまでは、コメント化しておきましょう。画面の動きに目を凝らしていると、想定外の動作してるかどうかの判断もしやすいですよ。

お礼

Rebellionさん　
アドバイス有難うございます。
Dirを使ったら、うまく行きました。

Application.ScreenUpdating = False
をコメント化して次回から進めてみます。
これで目標の作業のゴールが見えてきました。
本当に助かりました。

どうもありがとうございます。

回答No.3

imogasi

Sub ReadTxt()
Dim myTxtFile As String
Dim myBuf(7) As String
Dim i As Integer, j As Integer

Application.ScreenUpdating = False
i = 1
myTxtFile = ActiveWorkbook.Path & "\Fuji.txt"

Worksheets("郵便番号").Activate

Open myTxtFile For Input As #1
'---------
Do Until EOF(1)
Line Input #1, a

s = Split(a, Chr(9))
'データをセルに展開する
For j = 0 To UBound(s)
Cells(i, j) = s(j)
Next j
i = i + 1
Loop
'----------
Close #1
End Sub
－－－－
表題「ブックをひらかずにテキストファイルを取り込む」
と内容は違っているように思いますが。

お礼

アドバイスありがとうございます。
そうですね　厳密に言うとブックをひらかずにと言うより、新規ブックを作らずにテキストファイルをエクセルに取り込みたいのです。

色々思考錯誤してうまく作動するようになりました。
どうも有難うございます。

回答No.2

KenKen_SP

横レス失礼します。

回答は既にrebellionさんがされております。勝手ながら、コードをお借りしまして、データファイルの要素数が一定でない場合への対処や、処理速度という点から回答させていただきます。

配列のデータはセルへ一気に書き込んだ方が高速動作し、コードがすっきりします。タブで区切られたデータをSplit関数を使用して、一次元配列化し、Ubound関数で要素数を調べ、一気にセルへ転記しています。また、この方法ですと、要素数が固定されません。

i = 0
Do Until EOF(1)
Line Input #1, myBuf
　　wkdt = Split(myBuf, vbTab)
　　'データをセルに展開する
　　i = i + 1
　　Range(Cells(i, 1), Cells(i, UBound(wkdt) + 1)) = wkdt
Loop
Close #1

補足

アドバイス有難うございます。
下の方のやり方でうまく行ったので、
そこにこれを入れてみました。
入れる場所は下記のコードの
Input As #1の下でよろしいのですよね？

そこに入れると、データの2行目までの取り込みで止まってエラーが出てしまい、デバッグで見てみると、
Range(Cells(i, 1), Cells(i, UBound(wkdt) + 1)) = wkdt
が黄色く塗られています。
ここに何か問題が有るのでしょうか？
KenKenさんのアドバイスが高度すぎてイマイチ理解していなく、オウム状態で使わせてもらおうとしたので、自分で修正もできなくて申し訳ないのですが、
もう少し詳しく、教えていただけると助かります。
よろしくおねがいします。