[三流君] －－＞ [ＶＢＡで楽しく] －－＞ [バックナンバー一覧]

三流君VBA:テキストファイル処理指定した行を取り除いて複製を作る

概要:単なるテキストファイルを使った処理です。手作業でもできるけど、量が多かったので作ってみました。
時間的には、手作業のほうが速かったかも(作成、テスト、含めると手作業で操作したほうが)
まぁ、一度作れば同じような処理に使えるので、ヨシとしますか。

発行内容

VBAテキストファイル処理指定した行を取り除いて複製を作る

こんにちは。
今回は、xxxx.html ファイルから
<!--- アンケート --->
　　・
　　・
　　・
　　・
<!--- アンケートここまで --->
を取り除いて、複製を作る。
そんな テキストファイル処理にチャレンジしてみます。



/*
 * １. 今回のキッカケ
*/

下記、私のホームページで行っている、満足度(評価)のアンケート処理なのですが、

<!--- アンケート --->
<FORM ACTION="a.asp" METHOD="POST" TARGET="_top">
<INPUT TYPE="HIDDEN" NAME="K" VALUE="VBA">
<INPUT TYPE="HIDDEN" NAME="NO" VALUE="131">
<table border=0 cellpadding=8 width=100%><tr>
<td bgcolor="#ccffcc"><font size=-1>No.131を読んだ満足度(評価)は？<br>
5<INPUT TYPE="RADIO" NAME="a" VALUE="5">満足（参考になった）<br>
4<INPUT TYPE="RADIO" NAME="a" VALUE="4">まぁまぁ（一部参考になった）<br>
3<INPUT TYPE="RADIO" NAME="a" VALUE="3">普通（どちらとも言えない）<br>
2<INPUT TYPE="RADIO" NAME="a" VALUE="2">なんかなぁ（期待と違った）<br>
1<INPUT TYPE="RADIO" NAME="a" VALUE="1">不満（読んで損した気分）<br>
<INPUT TYPE="SUBMIT" NAME="btn01" VALUE="評価を送る"></font></td>
<td bgcolor="#eeeeff"><font size=-1>
作者に<b>感想・質問</b>を送る(気軽に質問・感想書いてください)<br>
あなたのお名前（ニックネーム）
<INPUT TYPE="TEXT" NAME="username" SIZE=30 VALUE="読者Ａ">さん<br>
<TEXTAREA NAME="HONBUN" ROWS=4 COLS=60>質問／感想</TEXTAREA><br>
作者からの返信は、
<INPUT TYPE="RADIO" NAME="re" VALUE="noreturn" CHECKED>不用
<INPUT TYPE="RADIO" NAME="re" VALUE="bbs">掲示板
<INPUT TYPE="RADIO" NAME="re" VALUE="email">E-mail
<INPUT TYPE="TEXT" NAME="email" SIZE=24 VALUE="xxxx@xxx.xxx">で受信したい<br>
<INPUT TYPE="SUBMIT" NAME="btn02" VALUE="質問・感想を送信">
＊質問・感想はメルマガで紹介する場合があります
</font></td></table></FORM>
<!--- アンケートここまで --->

荒れてます(おぃおぃ)、
で、今回やりたい処置は(作るプログラムは)、

vbaバックナンバーのHTMLファイルから、
<!--- アンケート ---> ～ <!--- アンケートここまで --->
の間を抜いて、複製を作りたいと思います。
※今回限りなので、エディターでやってもいいんだけど。
　VBAのテキストファイル処理の復習を兼ねて、
　作成してみたいと思います。

三流君VBAでテキストファイル(textfile)を操作する
http://www.ken3.org/cgi-bin/group/vba_textfile.asp
↑も、あわせて 見てください。

/*
 * ２．まずは、テキストファイルを１行読み、１行書く(単純にコピーかな)
*/

まぁ、データを除く前に、そのままコピーしてみます。

仕様書は単純に、

セル B5 に 入力ファイル名
セル B7 に 出力ファイル名

上記を入れて、実行ボタンが押されたら、

Sub TEST182_001()
'・入力ファイル(B5)を開く、出力ファイル(B7)を新規に開く
'・入力ファイルの最後まで
　　'・１行読み込み
　　'・１行書き込み
'・ファイルを閉じる
End Sub

こんなラフな感じで、直接テスト用関数にコメント書いただけです。

ファイルのオープンは
[No.27 テキストファイル処理 ファイルへの書き込み]
http://www.ken3.org/vba/backno/vba027.html
開けて（Open）、書いて(Print #)、閉めて(Close)の流れを書いてます。

読み込みは、
[No.29 テキストファイル処理　ファイルからの読み込み]
http://www.ken3.org/vba/backno/vba029.html
書き込みの次は読み込みじゃないけど、
・Input Line #で１行リード
・EOF(No) で、ファイルの終わりをチェック
・Instr関数で文字列を探した
そんなことを書いてます。

上記２つを参考にして、下記のように作成しました。

'・入力ファイル名(セルB5)を開く、出力ファイル名(セルB7)を新規に開く
'・入力ファイルの最後まで
    '・１行読み込み
    '・１行書き込み
'・ファイルを閉じる

Sub TEST182_001()

    Dim strInFileName  As String  '入力ファイル名
    Dim strOutFileName As String  '出力ファイル名
    Dim strBUFF        As String  'レコードを読みこむバッファ
    Dim nCNT           As Integer 'レコード数を数える

    '入力ファイルの処理
    strInFileName = Range("B5") '入力ファイル名はB5から代入
    If Dir(strInFileName) = "" Then 'Dir関数で ファイルの存在チェック
        MsgBox strInFileName & "が見つかりません"
        Exit Sub
    End If
    Open strInFileName For Input As #1 'ファイル番号１ 入力モードで開く

    '出力ファイルの処理
    strOutFileName = Range("B7") '出力ファイル名はB7から
    Open strOutFileName For Output As #2 'ファイル番号２で出力ファイル作成
    
    '入力ファイルの最後まで１行毎に読んで判断する
    nCNT = 0 '出力行カウンタを初期化
    Do While EOF(1) = False    'ファイル番号１（入力）がある間ループ
        Line Input #1, strBUFF 'ここで１行読み、変数へ代入される
        Print #2, strBUFF      'そのまま、変数をファイルに書き込む
        nCNT = nCNT + 1        '出力行数をカウントする
    Loop
   
    'ファイルは閉じようね
    Close #1  '入力ファイル
    Close #2  '出力ファイルも忘れずに

    '結果を表示
    MsgBox strOutFileName & "に" & nCNT & "行書き込みました"

End Sub



/*
 * ３．該当範囲を書き込まない 書き込みストップ と 再開の判断
*/

まぁ、全てを書き込む処理ができたので、
次は、
セル B9  に 除外開始の文字列     ( <!--- アンケート ---> ) から
セル B11 に 除外範囲終了の文字列 ( <!--- アンケートここまで ---> ) まで
を
セットして、ファイルの書き込み範囲をコントロールしてみます。

'・入力ファイル名(セルB5)を開く、出力ファイル名(セルB7)を新規に開く
'・入力ファイルの最後まで
    '・１行読み込み
    '除外の判断 セルB9と=になったら 書き込みOFF セルB11と=になったら再開 書き込みONにする
    '・１行書き込み
'・ファイルを閉じる

Sub TEST182_002()

    Dim strInFileName  As String  '入力ファイル名
    Dim strOutFileName As String  '出力ファイル名
    Dim strBUFF        As String  'レコードを読みこむバッファ

    Dim strCUT_Start   As String  '除外開始(書き込み停止)の文字列
    Dim strCUT_End     As String  '除外終了(書き込み再開)の文字列
    Dim bWriteFlg      As Boolean '書き込みフラグ ブール型
    Dim nCNT           As Integer '削除範囲の数を数える

    '入力ファイルの処理
    strInFileName = Range("B5") '入力ファイル名はB5から代入
    If Dir(strInFileName) = "" Then 'Dir関数で ファイルの存在チェック
        MsgBox strInFileName & "が見つかりません"
        Exit Sub
    End If
    Open strInFileName For Input As #1 'ファイル番号１ 入力モードで開く

    '出力ファイルの処理
    strOutFileName = Range("B7") '出力ファイル名はB7から
    Open strOutFileName For Output As #2 'ファイル番号２で出力ファイル作成
    
    '入力ファイルの最後まで１行毎に読んで判断する
    nCNT = 0 '削除カウンタを初期化
    bWriteFlg = True  '書き込みを初めはONにする
    strCUT_Start = Range("B9")   'セルB9から開始条件を代入する
    strCUT_End = Range("B11")    'セルB11から終了条件を代入する
    
    Do While EOF(1) = False    'ファイル番号１（入力）がある間ループ
        Line Input #1, strBUFF 'ここで１行読み、変数へ代入される
        
        '除外開始の確認
        If strBUFF = strCUT_Start Then
            bWriteFlg = False   '書き込みをOFFにする
            nCNT = nCNT + 1 '除外範囲数を+１する
        End If
        
        '書き込み処理
        If bWriteFlg = True Then  '書き込みの判断
            Print #2, strBUFF     'そのまま、変数をファイルに書き込む
        End If
        
        '除外終了の判断
        If strBUFF = strCUT_End Then
            bWriteFlg = True   '書き込みをONにする
        End If
    Loop
   
    'ファイルは閉じようね
    Close #1  '入力ファイル
    Close #2  '出力ファイルも忘れずに

    '結果をイミディエイトにDebug.printで表示
    Debug.Print strOutFileName & ":" & nCNT & " ブロック 削除して 書き込みました"

End Sub

単純に１つ変数 
    Dim bWriteFlg      As Boolean '書き込みフラグ ブール型
を作り、

開始は
        '除外開始の確認
        If strBUFF = strCUT_Start Then
            bWriteFlg = False   '書き込みをOFFにする
で、
再開は、
        '除外終了の判断
        If strBUFF = strCUT_End Then
            bWriteFlg = True   '書き込みをONにする
で判断して、True/falseをコントロールして、

書き込み処理 で
        If bWriteFlg = True Then  '書き込みの判断
            Print #2, strBUFF     'そのまま、変数をファイルに書き込む
        End If
のように使い、判断しました。



/*
 * ４．複数ファイルを連続で処理する。
*/

単独のファイルから 指定した範囲をなんとか除外して コピーすることができました。

５話単位の バックナンバーは ２７個、
１話単位は １８１個のhtmlファイルがあります。

このファイル名をB5 と B7を変えて 実行ボタンを押す、
そんな処理を行うと大変なので、

20行目から B列に入力ファイル  C列に出力ファイル

B20 入力ファイル  C20 出力ファイル
B21 入力ファイル  C21 出力ファイル
　　　・　　　　　　　　・
　　　・　　　　　　　　・
　　　・　　　　　　　　・
　　　・　　　　　　　　・
B50 入力ファイル  C50 出力ファイル
1  
と、入出力ファイル名を書き込み、１つ１つ B5とB7に代入して 連続処理してみます。
※まぁ、バックナンバーは連番だから、プログラムで用意できるけど・・・

'B20から データがなくなるまで、
'B5 入力ファイル名 B7 出力ファイル名 に それぞれデータをセット後、
'ファイル処理の TEST182_002 を コールする
Sub TEST182_MAIN()

    Dim y As Integer
    
    For y = 20 To 9999  '実際に9999までループはしないけど
        'いきなりY行目のデータ存在チェック、無きゃループを抜ける
        If Trim(Cells(y, "B")) = "" Then Exit For  '空白かチェックする
        Cells(y, "B").Select  'カーソル移動 セルの選択(必要ないけど、おまけ)
        
        '入力ファイル名(B5) と 出力ファイル名(B7) を セットする
        Range("B5") = Trim(Cells(y, "B"))  '入力ファイル名
        Range("B7") = Trim(Cells(y, "C"))  '出力ファイル名
        
        '↑パラメーターセット後↓ファイル処理の関数を呼ぶ
        Call TEST182_002   '単純にコール、呼んだだけです。
    Next y

    MsgBox "処理が終了しました、確認してください。"
    Range("B15").Select  'カーソルを戻す。

End Sub

ポイント は ループを作って、
        '入力ファイル名(B5) と 出力ファイル名(B7) を セットする
        Range("B5") = Trim(Cells(y, "B"))  '入力ファイル名
        Range("B7") = Trim(Cells(y, "C"))  '出力ファイル名
で、パラメータをセットして 単独実行の関数を呼んだ、ただ、それだけです。



/*
 * ５．終わりの挨拶
*/

今回は、
・テキストファイルの オープン
・読み込みと書き込み
・指定範囲を書かない(カットする)
・連続実行
なんて流れでした。

ファイルを選択したい や 上書き処理ができないなど、まだまだ、問題あるけど、
部分カットで使ってみます。
※あとは、広告などの 部分 差し替え(交換)があるといいのかなぁ。

プログラム作りは
^^^^^^^^^^^^^^^^
う～ん・・・
まぁ、人それぞれ、十人十色、百社百色だけどね。
      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

今回も逃げるように。。。。失礼します。

ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、

種類別のリンクや広告など

気になったジャンル↓を選択してください。

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作するサンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記３つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他：VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print とイミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは入力・処理・出力]

※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。
※※読んで、気分を悪くされたらスミマセン。

Blogとリンク:[三流君の作業日記]/ [VBAやASPのサンプルコード]/ 広告-[通販人気商品の足跡]

[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]