Excel97 VBA CSVから固定長 読者からアドバイス〜

本文(発行内容)

＜Excel97 VBA CSVから固定長 読者からアドバイス〜＞
目次
1.はじめの挨拶
2.読者より、アドバイス 関数分割について
3.読者より、アドバイス 自作関数作ってみました
4.質問コーナー？
5.おわりの挨拶
----------------------------------------------------------------------------
/*
 * １.こんにちは
*/
こんにちは。
今回は、前回の積み残し、
Excel97 VBA CSVから固定長
です。読者より２・３ヒントをいただきました。

なぜか、ＦＴＰの調子が悪いので、ＨＰは、更新していません
（今回、画像付き、サンプルありませんが、、、）

えっ、画像はいつも見てないって、、そんなこと言わないで、、
見てくださいよ。
（ホントのところは、どうなんだろう？）

/*
 * ２．読者より、アドバイス 関数分割について
*/
転載不可、ｋｅｎ3の言葉で書いてください
と書かれたメールでアドバイスをいただきました。
ア．関数は、分割してください。
　　前回のサンプル、1つのモジュールに詰込んでました。
　　ファイル名作成・処理・結果をメモ帳で表示。
　　これだと、1つ1つがわかりにくいみたいなので、
　　今回、メイン部分と呼び出し側の2つに分けました。
　　幕ノ内弁当で、おかずのエリアを分けた。。
　　シャケがおいしければ、シャケだけ抜いて、
　　シャケ弁当を作りやすいように、
　　1つ1つの単位に分けるって、大切かもしれません。
　　＊アドバイス、どうもです。
　　マズイ組み合わせがあったら、そこだけ修正、、後々の流用ですね。
イ．Ｓｔｒｃｏｎｖで変換後処理してみては？
　　文字コードでバイト数がわからないなら、
　　strconvで変換後処理してみては？
　　と、アドバイス含めて、いただきました。
　　（回答をズバリ書いてくれないのが、ホントはやさしい師匠？）

私なりの答え（再度の味付け）を下記に記載します。
＊まだ、変換サイズなどを外部に出すなど、してませんが、、
'--------
Sub TEST_MAIN()

    Dim strINFname  As String
    Dim strOUTFname As String

    ' csvtotxt.xls のパスを使用して、INファイル、Outファイルの
    'ファイル名を作成する
    strINFname = ActiveWorkbook.Path & "\Sample.txt"
    strOUTFname = ActiveWorkbook.Path & "\out.txt"
    
    'お行儀良く、入力ファイルがアルか、チェックしますか、、、
    If Len(Dir(strINFname) & "") = 0 Then
        MsgBox strINFname & "ファイルが見つかれません"
        Exit Sub  'モジュールを抜ける
    End If

    'サンプルモジュールをコールする
    Call Excel97_CSVtoTXT(strINFname, strOUTFname)

    '結果をメモ帳表示
    Shell "notepad.exe " & strOUTFname, vbNormalFocus

End Sub

'サンプルモジュール
'固定処理が多いので流用・汎用性が無い、なぁ。。
'サイズを（も）引数で渡したり、工夫しないと、、
Sub Excel97_CSVtoTXT(strINFname As String, strOUTFname As String)
    
    Dim nYLINE As Integer
    Dim x      As Integer
    Dim OUT_FNO%
    
    Dim nOUTSIZE(10) As Integer     '１０もいらないでしょ、、、
    Dim strOUTBUF As String
    
    '入力ファイルをＣＳＶで開く      ↓変数に変更
    Workbooks.OpenText FileName:=strINFname, StartRow:=1, 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))
        
    '出力テキストファイルを作成する
    'シーケンシャル ライト モードで開きます
    OUT_FNO = FreeFile
    Open strOUTFname For Output As #OUT_FNO
    
    '出力先のサイズを代入
    'サンプルデータは会員番号１（８桁）、漢字氏名（２０桁）、ローマ字
    '（１８桁）、生年月日（１０桁）、会員番号２（１０桁）、暗証番号
    '（３桁）で構成されています。
    nOUTSIZE(1) = 8
    nOUTSIZE(2) = 20
    nOUTSIZE(3) = 18
    nOUTSIZE(4) = 10
    nOUTSIZE(5) = 10
    nOUTSIZE(6) = 3
    
    'データが無くなるまでループ（Ａ列が空白になるまで）
    'おいおい、データが１行しかなかったら、どうなるの？＜＜＜知らない、、
    nYLINE = 2   'タイトルを抜かし、２行目から、スタート
    While Len(Cells(nYLINE, 1) & "") <> 0
        For x = 1 To 6 'AからF列まで処理
            strOUTBUF = Cells(nYLINE, x)
            'XXバイトに満たない場合、空白を後ろに詰めています
            strOUTBUF = LeftB(StrConv(strOUTBUF & Space(nOUTSIZE(x)), vbFromUnicode), nOUTSIZE(x))
            strOUTBUF = StrConv(strOUTBUF, vbUnicode)
            'データ書きこみ
            Print #OUT_FNO, strOUTBUF; '←を付けると改行されない
        Next x
        Print #OUT_FNO, ""     '改行のみする
        nYLINE = nYLINE + 1  '忘れないようにカウントアップ
    Wend
    
    Close #OUT_FNO                  ' ファイルを閉じます。

End Sub
'--------
こんな感じです。







/*
 * ３．読者より、アドバイス 自作関数作ってみました
*/
無いものは、自分で作ろうって、こころ、忘れてた、、、
読者からいただいた、固定長、右スペース埋め関数です。。
'----------------------------------------
Public Function SetKoteicho(input_str As String, length As Integer) As String
    Dim check_char As Integer       'Asc関数で全角かどうか調べる文字の位置
    Dim sjis_length As Integer      'シフトJIS換算の文字数
    Dim sjis_code As Integer        '文字コード(シフトJIS)
    Dim output_str As String        '固定長に変換した文字列
    sjis_length = 0
    check_char = 1
    Do
        sjis_code = Asc(Mid(input_str, check_char, 1))
        '文字コードから全角文字か半角文字かを調べる
        If sjis_code > 256 Or sjis_code < 0 Then
            '全角文字
            sjis_length = sjis_length + 2
        Else
            '半角文字
            sjis_length = sjis_length + 1
        End If
        check_char = check_char + 1
    Loop While (check_char <= Len(input_str))
    
    '必要なだけスペースを加える
    output_str = input_str & Space$(length - sjis_length)
    
    SetKoteicho = output_str
End Function
'--------------------------------------

'下記のようにコールすると、使用できます
        For x = 1 To 6 'AからF列まで処理
            '感謝して、関数を使用する、、、
            strOUTBUF = SetKoteicho(Cells(nYLINE, x), nOUTSIZE(x))
　　　　　　'-----------↑^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
            Print #OUT_FNO, strOUTBUF; '←を付けると改行されない
        Next x
'--------------------------------------

ありがたいですね、、、ホント。

/*
 * ４．質問コーナー？
*/
----------
>ＶＢでＶｏｉｃｅ　Ｃｌｏｃｋを作ってみたいのですが．．．
>簡単な方法が有りますか。
>朝、昼、夕方の三回だけしゃべってくれればいいのですが。
----------

タイマーイベントのネタで使用かなぁ、、、
ネタようにメモメモ。

/*
 * 5.終わりの挨拶
*/
今回、読者任せでした（厨房を貸して、料理作ってもらった？）

年末ですね、、、来年は構想を考えて、
少しは、講座らしくしようかなぁ？

では、また。　三流ＰＧ Ｋｅｎ３でした。

ページフッター

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

リンクや広告など

項目別に本音？それとも建て前？的な記事をまとめました。

Blogとリンク:[三流君の作業日記]/ [愚痴(Bookmark)]/ [広告Blog(Bookmark)]