Excel VBA テキストファイルからの抽出

質問

Excel VBAにて、テキストファイルから文字列を選別して、それをエクセルファイルのテキストボックスに張り付けるコードの記述をご教授いただけますでしょうか。

環境はWindows7 Pro Excel2010
下記テキストファイルです。

test.txt

IDENTIFICATION DIVISION.
PROGRAM-ID. sample
AUTHOR. XXX
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT A ASSIGN TO B
SELECT C ASSIGN TO D
DATA DIVISION.
FILE SERECTION.

この FILE-CONTROL.と DATA DIVISIONの間に挟まれている
SELECT A ASSIGN TO B
SELECT C ASSIGN TO D

この2行を取り出して、エクセルファイル上にあるテキストボックス張り付ける処理です。
よって、FILE-CONTROL.と DATA DIVISION.の間にある不特定多数の行を抽出するロジックです。

テキストボックスに張り付ける前の行を抽出するだけでも、ご教授頂けたら幸いです。

よろしくお願いします。

回答No.1

real beatin（@realbeatin） · ベストアンサー

こんにちは。

ANSIテキストだと仮定して、基本通りの書き方です。
もし、テストしてうまく行かない場合は、
望んだ結果とどう違うかの説明と合わせて、
フォルダ名、テキストボックス名（シート名？）、
文字コード、などを詳しく補足してください。

Sub Re8938350()
Const SLF = vbLf　'　改行文字を指定
Dim sFile As String　'　ファイルパス
Dim sTemp As String　'　１行ずつ読み込み
Dim sBuf As String　'　バッファ
Dim nFree As Integer　'　空き番号ファイル番号
Dim flg As Boolean　'　抜出し開始
　　sFile = "test.txt"　'　ファイルパス（必要ならフォルダパスも指定！！）
　　nFree = FreeFile　'　空き番号ファイル番号
　　Open sFile For Input As #nFree　'　.txtを読み込み用に開く
　　　　Do Until EOF(nFree)　'　.txtの終端まで読み込めるようにループを仮設定
　　　　　　Line Input #nFree, sTemp　'　１行ずつ読み込む
　　　　　　If flg Then　'　抜出し開始フラグがTrueなら
　　　　　　　　If sTemp Like "DATA DIVISION." Then Exit Do　'　抜き台終了条件でループを抜ける
　　　　　　　　sBuf = sBuf & SLF & Trim$(sTemp)　'　バッファの終端に改行と１行分のテキストを追加
　　　　　　Else　'　抜出し開始フラグがFalseなら
　　　　　　　　flg = (sTemp Like "FILE-CONTROL.")　'　抜き台開始条件　フラグをTrueに
　　　　　　End If
　　　　Loop
　　Close #nFree
　　sBuf = ""
　　sBuf = Mid$(sBuf, Len(SLF) + 1)　'　先頭の改行を削除
　　If Len(sBuf) Then　'　バッファが空でなければ
　　　　Sheets("Sheet1").TextBox1.Text = sBuf　'　"エクセルファイルのテキストボックスに" ？
　　' ' ↑テキストボックスの↑オブジェクト名（親オブジェクト）を正しく指定
　　End If
End Sub

回答No.3

imogasi

コボル.txtというテキストファイルがあるとして
標準モジュールに
Sub test01()
Open "C:\Users\ＸＸＸＸＸＸＸ￥コボル.txt" For Input As #1
i = 2 'Sheet1のA列2 行目より書き出し
Do While Not EOF(1)
Line Input #1, txt '１行読み
'--FILE-CONTROL行が出現か
p = InStr(txt, "FILE-CONTROL")
If p <> 0 Then
fnd = "Y"
GoTo p1
End If
'---DATA DIVISION行が出現かー＞処理終了
p = InStr(txt, "DATA DIVISION")
If p <> 0 Then GoTo end1 '以下のレコード行は処理打ち切り
'--Ｓｈｅｅ１へ書き出し
If fnd = "Y" Then
Worksheets("Sheet1").Range("A" & i) = txt
i = i + 1
End If
p1:
Loop '次行にあたるレコードへ
'--
end1:
MsgBox "処理終了"
Close #1
End Sub
ーーーー
実行して
Ｓｈｅｅｔ１のＡ列
SELECT A ASSIGN TO B
SELECT C ASSIGN TO D

・・・
このロジックで抽出に漏れは起こりますか？
四十年も前にコボルを離れたので、ＳＥＣＴＩＯＮ、ＤＩＶＩＳＩＯＮとかの構成関係を忘れた。
またＢａｓｉｃ時代（Ｖｉｓｕａｌがつかない）の書き方ですが、ＶＢＡはＶＢ６相当なので、まだ使えるようだ。
＞テキストボックス張り付ける処理
は質問者がやってみて。
ーー
色んなロジックはあろうが、テキストボックスでは検索は１行ずつ読む上記のようなことにならざるを得ないと思う。
そう頻出するパターンでもなく、力ずくでもやる、ロジックの勉強が肝心。

回答No.2

real beatin（@realbeatin）

＃１です。訂正です。

すみません。デバッグ用に書いた余分な記述を消し忘れていました。
＃１のままでは、何も結果が返りませんでした。
　　sBuf = ""
の１行を削除（トルツメ）してください。

ついでに、書き忘れていたことですが、
（本題とは無関係ですが、動作確認には影響する事柄として）
「テキストボックス」というのが、
シート上に配置するActiveXコントロールの[テキスト ボックス]
または
ユーザーフォームの[テキスト ボックス]
の何れかである場合は、
[テキスト ボックス]のプロパティ .MultiLine を True
にしておかないと改行を表示することは出来ませんので、
確認してください。

訂正、追記、以上です。失礼しました。