[No.170 IE Aタグのリンク先を.Click(クリック)してみた]
[No.171 Outlook VBA 受信MailにフラグをSET .Folders .Itemsを探る]
[No.172 StrConv関数のvbNarrow変換に似た処理 全角ABCを半角ABCへ変換する]
[No.173 プログラムの修正・追加のいろいろな方法?開発の進め方?]
[No.174 プログラムの修正 縦に羅列 と 配列で操作]

www.ken3.org(サイト内)から Google を利用して、

三流君 VBAで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー] [VBA系 TOP] [三流君 TOP]



No.170 2005/03/12
IE Aタグのリンク先を.Click(クリック)してみた
[ページTOPへ戻る]

<IE Aタグのリンク先を.Click(クリック)してみた>

どうも、三流プログラマーのKen3です。 今回は、 IE で フレームの先のJavaScriptの起動にチャレンジしてみます。 といっても、.Runや.Scriptは攻略できなくて、逃げたんだけどね。

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

掲示板にいただいた質問 --- >Ken3さんの「InternetExplorer操作 Frameと遊ぶ Objectを探る方法」 >にて以下のようなコードがありますよね。 >----------------------------------------------------------- >Sub ie_test_2() > > Dim objIE As Object '型は何でも来い、得意のObject型 > > 'インターネットエクスプローラーのオブジェクトを作る > Set objIE = CreateObject("InternetExplorer.application") > objIE.Visible = True '見えるようにする(お約束) > > 'フレームページを表示する > objIE.Navigate "http://www.ken3.org/vba/test116.html" > > '表示終了まで待つ > Do While objIE.Busy = True > '何もしないループ(笑) > DoEvents > Loop > > 'TOPのオブジェクトから項目まで.で行く(笑) > objIE.Document.frames("F_RIGHT").Document.all("userid").Value = "Ken3" > objIE.Document.frames("F_RIGHT").Document.all("pass").Value = "aaa" > >End Sub >--------------------------------------------------- > >これを参考にして自動ログインからフレームのテキストボックスに >文字を代入する所までは出来たのですが、最後にJavaScriptを動かす >所がうまくいきません。 > >objIE.navigate "javascript:******()" →ダメ >objIE.Document.frames("F_RIGHT").***** →ダメ --- と質問をもらった。 javascriptかぁ・・・ 前に、 No.162 IE データセット後、JavaScriptを起動する http://www.ken3.org/vba/backno/vba162.html で Me.WebBrowser1.Document.scripts(n) とか、scriptsがスクリプトオブジェクトだから、 これを.RUNとかないかなぁと探ってみましたが、 目的の処理が見つかりませんでした。 そこで、 <a href = "JavaScript:parts('B')">〜 とリンクになっているから、それだったら、 .Navigate2 "JavaScript:parts('B')" でOKなのか?って発想でテスト実行して逃げてたっけ・・・

/* * 2.あれでできるんじゃない?と無責任な腰高の先輩達 */

上司や先輩は経験豊富なので聞いてみると、無責任な回答をもらったりする。 下記、私の無責任な回答 ---- >タイトル:.fireEventでイベントを発砲できたらいいな > >> objIE.navigate "javascript:******()" →ダメ >> objIE.Document.frames("F_RIGHT").***** →ダメ > >もし、JavaScriptが ><DIV align=right><SELECT onchange=Rdp(); name=JYO> > <OPTION value=0 selected>選択項目 </OPTION></SELECT></DIV></TD></TR> ><TR> ><TD><B>レース</B><BR> ><DIV align=right><SELECT onchange=Hdp(); name=Race> > <OPTION value=0 selected>選択項目 </OPTION></SELECT></DIV></TD></TR> > >みたいに、 >onchange >とかイベントに割り当たっていたら、 >.fireEventなんてメソッドがあったり。 > >No.155 IE SELECT後 .fireEventでJavaScriptのイベントを起動 >http://www.ken3.org/vba/backno/vba155.html > >↑を参照してください。 > >そのまま起動だったら・・う〜ん。。。 > >htmlを見てないのでなんともいえませんが、 --- なんて回答してました。 まるで腰高の内野手みたいな一歩も動く気ない回答だ。 ※サッカーの腰高ディフェンダー、バスケの棒立ち選手って感じかな。 いつから自分が嫌いな歳だけ高い(プライドも高い)プログラマーになっちまったんだ、 動けよコラ、ボール(質問)に真剣に飛びつけよと思いつつ・・・ (※自分から動けなくなった先輩プログラマーって...イヤだけど自分がなるとは・・) >htmlを見てないのでなんともいえませんが、 けっ、プログラムや解説は三流でも、 できない時の予防線のハリカタは超一流ですね。 ~~~~~~~~~~~~~~~~~~ (※できないのを認めたくない、プライドだけが高いプログラマーって嫌だよね。   見習いたくないけど私みたいな先輩達が一部に居るのも(多い?)のも事実だったり)

/* * 3.重い腰を上げ、テスト環境を作る */

いつもの自己嫌悪に落ちつつ、もっと親切な回答しなきゃと思っていたら、 質問者よりソースの一部をもらう(ボールが飛んできた) ----- >フレームを指す "objIE.Document.frames("F_RIGHT")."に >"FireEvent"、"navigate"を組み合わせて何回も試してみたのですが。 >とにかくInternetExplorerの操作は初めてなので、すべて試行錯誤の >状態です。 > >ちなみにソースはこんな感じです。 >-------------------------------------------------------- ><b>顧客番号</b></font>&nbsp;&nbsp;<input TYPE="TextBox" size="6" Name="number" Id="Job" maxlength="8"> > </font><font FACE="Verdana, arial, geneva" COLOR="#000000" SIZE="2"> ><b><a HRef="JavaScript:gonumber();">検索</a></b></font></td> >--------------------------------------------------------- > >"number"に数字を代入する所までは出来ています。 >あとはJavaScript:gonumber()動かせれば・・という所です。 ----- a タグで JavaScript:gonumber() へ飛んでるのね。 こいつを攻略するかぁ。 環境を相手から教わったので、まずテスト環境を作ります。 ※いい先輩・上司のテクニックって、  質問して来た後輩から、状況をうまく聞きだすんだけど、  私はなんとなくうまく聞き出せなかったり。 ※※使えないプライド高い先輩予備軍でプライド高い新人プログラマー、   なかなか状況を聞き出しにくい、そんな後輩も居るのでいい先輩も難しいんだけど 今日は余談が長い、もっと短く要点をまとめてください。。。 左右のフレームを呼び出すメインのHtmlを作成します。 test170main.html <html> <HEAD> <TITLE>三流君 VBAで楽しくプログラミング</TITLE> </HEAD> <frameset COLS="160,*" FRAMEBORDER=1 BORDER=1 FRAMESPACING=0> <frame SRC="http://www.ken3.org/vba/menu-vba.html" NAME="F_MENU"> <frame SRC="http://www.ken3.org/vba/test170f.html" NAME="F_RIGHT"> </frameset> </html> 次にテストで使う(問題のフレーム)htmlを作成します。 test170f.html <HTML> <head> <title>A タグでJavaScriptを起動するHTML</title> </head> <BODY BGCOLOR="#ffffff"> <h1>A タグでJavaScriptを起動するHTML</h1> リンク先を押すとJavaScriptが起動します <br> <FORM name=test> <TABLE BORDER="1"> <tr> <td><b>顧客番号</b></td> <td><input TYPE="TextBox" size="6" Name="number" Id="Job" maxlength="8"></td> <td><a HRef="JavaScript:gonumber();">検索</a></td> </tr> <tr> <td><b>担当者番号</b></td> <td><input TYPE="TextBox" size="6" Name="tanto" Id="Tan" maxlength="8"></td> <td><a HRef="JavaScript:tanto();">検索</a></td> </tr> </TABLE> </FORM> <script type="text/javascript"> <!-- //ここからJavaの関数を書いてみる function gonumber(){ // gonumber 検索が押された時に alert("gonumberが呼ばれたよ、何か処理するよ"); } function tanto(){ // tanto 検索が押された時に alert("tantoが呼ばれたよ、何か処理するよ"); } // --> </script> <hr> </BODY> </HTML> と、簡単なテストプログラムを書いてみました。 http://www.ken3.org/vba/test170main.html ↑テストのHTMLを実行してみてください。

/* * 4.一緒に失敗してみる(同じ目線で失敗してみる)・・・ */

上から(安全な場所から)、いいかげんなことを言うのではなく、 同じ目線で(同じ失敗で)はじめてみたいと思います。 ※居るんだよね口では偉そうなこと言ってて、現場に来ると(現状を把握すると)  こりゃ大変だ、予算が、納期が・・と担当者以上にあわてるヤツが・・・ まずは、 http://www.ken3.org/vba/test170main.html を読み込んで、 JavaScript:gonumber()を試してみます。
Sub ie_test_001()

    Dim objIE    As Object '型は何でも来い、得意のObject型

    'インターネットエクスプローラーのオブジェクトを作る
    Set objIE = CreateObject("InternetExplorer.application")
    objIE.Visible = True '見えるようにする(お約束)

    'フレームページを表示する
    objIE.Navigate "http://www.ken3.org/vba/test170main.html"

    '表示終了まで待つ
    Do While objIE.Busy = True
        '何もしないループ(笑)
        DoEvents
    Loop
    '↑ステータスを見ないとフレームの場合は良くないよ、、、

    'TOPのオブジェクトから項目まで.で行く(笑)
    objIE.Document.frames("F_RIGHT").Document.all("Job").Value = "4649"
    objIE.Document.frames("F_RIGHT").Document.all("Tan").Value = "114"

    'JavaScriptを起動する
    objIE.Navigate "JavaScript:gonumber()"

End Sub
ポイントは無く、 'JavaScriptを起動する objIE.Navigate "JavaScript:gonumber()" を+して、テストしてみた。 データはセットされるけど無反応?かよ?と思ったら、下のステータスバーに ページでエラーが発生しましたと出てますね。 そのまま .Navigate "JavaScript:gonumber()"はダメなのね。 同じ目線に立って簡単には、できないことがわかった。 .fireEventもイベントでJavaScriptを起動してないし、 単なるクリックで起動だしなぁ。 まだまだ、同じ目線に立ってないよオマエハマダコシダカなんだよ。 えっ、同じ目線に立って、同じツラサを味わって見たってば自分なりに。 それは、担当者と同じ目線だろ、開発担当者の気持ちがわかっただけだろコラ!!! 相手側、客先担当者(ここではIE自身かな)の気持ちになって考えてみろよ。 ※意外と難しいのが立場によって見方が違ったり、 自分側だけじゃなくて、相手側に立って自分を見るってことも必要。 ※時には使う人の立場(開発中はOSや言語の立場とか??) フレームを扱っているアプリケーションIE様から見たら、 .Navigate "JavaScript:gonumber()" ってなんだ? 私は(test170main.htmlは)、フレームのソースしか知らないよ、 どこに飛べって言ってんだよ って感じなんだろうなぁ。 私をコントロールしたかったら、 人間と同じようにマウスを移動させてクリックしろって??? 言ってるの?API使って自動に? そんなこと言ってないでしょ!!! クリックしろって自分でも言ってるでしょ。

/* * 5..links(リンク先を探し) .Click してみた */

クリックしろ??? どうやって?? No.97 InternetExplorer.application操作 .Clickでクリック http://www.ken3.org/vba/backno/vba097.html データをフォームに objIE.document.all.userid.Value = "Ken3" 'ユーザー名 objIE.document.all.pass.Value = "aaa" 'パスワード でセットして、その後、 objIE.document.all.btn01.Click 'クリックメソッドを実行 単純にクリックメソッドを実行して、自動ログイン処理を作成しました。 とか、言ってるジャン。 だからそれは、フォームのボタンだからクリックできるんでしょ。 あっそ。リンクのアンカーは(Aタグは)クリックできないんだ。 リンク先へ飛ぶ時はいつもクリックしてるけどね。 あまりイジメナイデ下さいよ。ってことは、 あっでも、 <td><a HRef="JavaScript:gonumber();">検索</a></td> とかで名前が付いていません。残念です。 なんですぐにあきらめるかなぁ。 名前が付いてなきゃ私を(IEを)操作できないのかよオマエは(プログラマーは)。 No.148 IE ラジオボタン(RADIO)の.Checkedと.Clickの違い http://www.ken3.org/vba/backno/vba148.html INPUT Type=RADIO(ラジオボタン)のオブジェクトに対して、 .Checkedだとイベントが起動しないが、 .ClickだとonClickのイベントが起動する、 そんな違いの話を少し書いてます。 この中で、 '区分を探してセットする For Each objITEM In objIE.document.all '.allからオブジェクトを探す '名前がsentakuで値がa?のラジオボタンを探す If objITEM.TAGName = "INPUT" Then 'まず、タグでINPUTか判断 Debug.Print objITEM.Name 'TESTで値を表示 Debug.Print objITEM.Value 'TESTで値を表示 '↓の条件でクリックするオブジェクトを探す If objITEM.Name = "sentaku" And objITEM.Value = strRADIO(nNO) Then objITEM.Click '素直にクリックしてみた(笑) Exit For '目的の処理が終わったので、ループを抜ける End If End If Next と、タグの名前と値を探して.Clickしてました。 だとすると、フレームのドキュメントからリンク情報を取り出し、 探したオブジェクトに対してクリック(.Click)すれば、起動するのかな??? リンク先を探すのは、 No.71 IE操作 リンク先を取出す .Document.links(i).href http://www.ken3.org/vba/backno/vba071.html で、 objIE.Document.links.Length でリンクの数を取得できるので、 'リンク数分まわす For i = 0 To objIE.Document.links.Length - 1 Cells(nYLINE, "A") = "'" & objIE.Document.links(i).outerText Cells(nYLINE, "B") = "'" & objIE.Document.links(i).href Cells(nYLINE, "C") = "'" & objIE.Document.links(i).outerHTML nYLINE = nYLINE + 1 'セット位置を+1する Next i と objIE.Document.links(i).outerText objIE.Document.links(i).href objIE.Document.links(i).outerHTML をそれぞれセットしてみました。 これを使って、links(i).Clickしてみますか。
Sub ie_test_002()

    Dim objIE    As Object '型は何でも来い、得意のObject型

    'インターネットエクスプローラーのオブジェクトを作る
    Set objIE = CreateObject("InternetExplorer.application")
    objIE.Visible = True '見えるようにする(お約束)

    'フレームページを表示する
    objIE.Navigate "http://www.ken3.org/vba/test170main.html"

    '表示終了まで待つ
    Do While objIE.Busy = True
        '何もしないループ(笑)
        DoEvents
    Loop
    '↑ステータスを見ないとフレームの場合は良くないよ、、、

    'TOPのオブジェクトから項目まで.で行く(笑)
    objIE.Document.frames("F_RIGHT").Document.all("Job").Value = "4649"
    objIE.Document.frames("F_RIGHT").Document.all("Tan").Value = "114"

    'フレームのドキュメントを変数に保存して、
    'リンクのアンカーオブジェクトをクリックする
    Dim n As Integer
    Dim objFDOC As Object  'フレームのドキュメントを保存する
    Set objFDOC = objIE.Document.frames("F_RIGHT").Document '代入
    'リンク情報からオブジェクトを探し.Clickする
    For n = 0 To objFDOC.links.Length - 1 'リンク数分まわす
        Debug.Print objFDOC.links(n).href 'デバッグで表示する
        'リンク先(.href)をチェックする(文字列比較する)
        If objFDOC.links(n).href = "javascript:gonumber();" Then
            objFDOC.links(n).Click  '.Clickでクリックしてみた
            Exit For  '見つかったので強制的にループを抜ける
        End If
    Next n
    
End Sub
処理のポイントは Dim objFDOC As Object 'フレームのドキュメントを保存する と1つ変数きって、 Set objFDOC = objIE.Document.frames("F_RIGHT").Document '代入 で、フレームのオブジェクトを代入しておいて、 ループでリンク情報.linksを探ります。 'リンク情報からオブジェクトを探し.Clickする For n = 0 To objFDOC.links.Length - 1 'リンク数分まわす Debug.Print objFDOC.links(n).href 'デバックで表示する 'リンク先(.href)をチェックする(文字列比較する) If objFDOC.links(n).href = "javascript:gonumber();" Then objFDOC.links(n).Click '.Clickでクリックしてみた Exit For '見つかったので強制的にループを抜ける End If Next n ↑今回比較するのは飛び先の文字列でjavascript:gonumber();を探してます。 最大のポイントは.hrefの比較は、ソースそのままじゃなくって中身が javascript:gonumber(); javascript:tanto(); になっていることに注意・・Debug.Print objFDOC.links(n).hrefで気が付いたよ <td><a HRef="JavaScript:gonumber();">検索</a></td> だから、そのままJavaScriptの大文字のまま、 If objFDOC.links(n).href = "JavaScript:gonumber();" Then としたいけど、 If objFDOC.links(n).href = "javascript:gonumber();" Then が正解

/* * 6.終わりの挨拶 */

今回は、 フレームの先の <td><a HRef="JavaScript:gonumber();">検索</a></td> を起動する、そんな話でした。 えっ、日頃の愚痴にしか聞こえなかったって? まぁ、前半に変な表現ありますが、気にしないでね。 そんなプログラマーの愚痴が見たい人は、 http://www.ken3.org/guchi/ ← 三流プログラマー 業務の愚痴 http://www.ken3.org/backno/backno_guchi_mokuji.html ←バックナンバー もヨロシクデス。 三流君VBAでInternetExplorer.Applicationを操作する(IE操作) http://www.ken3.org/cgi-bin/group/vba_ie.asp ↑にVBA IE操作系のメルマガまとめてます、こちらも一口どうぞ。 ※今回、かなりの複合技だったけど、1つ1つはなれれば簡単かなぁ。 全体的に斬新なテクニック系のネタじゃないのですが、 何か、感じ取ってくれると、うれしいです。 AB型の変わり者、三流プログラマーのKen3でした。

No.171 2005/03/28
Outlook VBA 受信MailにフラグをSET .Folders .Itemsを探る
[ページTOPへ戻る]

<Outlook VBA 受信MailにフラグをSET .Folders .Itemsを探る>

どうも、三流プログラマーのKen3です。 今回は、 VBA から Outlook の受信トレイを探り、 メールアイテムのフラグを変更してみたいと思います。

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

掲示板にいただいた質問 --- >三流君VBAでOutlookを操作するの >No.161 Outlook VBAでフラグ作成は非常にためになりました。 >私の場合は新規作成メールにフラグをつけるのではなく >すでに受信しているメールに「実施済み」という意味合いでフラグを付けたい >のですが、可能でしょうか >よろしくお願いいたします。 --- と質問をもらった。 No.161 Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy http://www.ken3.org/vba/backno/vba161.html で行った方法は、新規に作成するメールに対してだったので一直線だったからなぁ。。 受信済みのメールを選択して、フラグを付けたいのね・・・

/* * 2.受信トレイの選択 .Foldersを探る */

フラグを付けるメールを選びたいよね。 とその前に、受信トレイとか送信トレイ、下書きなどのフォルダーの選択かぁ・・・ Excel VBA からOutLookデータを読む http://www.ken3.org/guchi/backno/guchi022.html ↑愚痴系のNo.22 ナツカシイ・・ と過去の自分を参考にすると(Googleで探したら本人忘れてた自分のサイトを発見(笑)) .Foldersってオブジェクトで探れそうです。 フォルダー名をテストで表示させて見ました。
Sub aaa()
    'Outlookを開き、フォルダー名をメッセージボックスでテスト表示
    Dim objOL As Object      'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim n As Integer     'カウンター

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの数を表示する
    MsgBox "親のフォルダー数は" & objNAMESPC.Folders.Count

    'フォルダーの下、第二階層でループさせる
    For n = 1 To objNAMESPC.Folders(1).Folders.Count
        '1番目のさらに下、n番目のフォルダー名を表示する
        MsgBox objNAMESPC.Folders(1).Folders(n).Name
        Debug.Print objNAMESPC.Folders(1).Folders(n).Name
    Next n

    '後始末
    objOL.Quit

End Sub
実行すると、下記のフォルダー名が表示されると思います。 削除済みアイテム 受信トレイ 送信トレイ 送信済みアイテム 予定表 連絡先 履歴 メモ 仕事 手抜きで、 objNAMESPC.Folders(1).Folders(n) と1番目のルートから2階層目を回してますが、 複数のアカウントを管理されている人は、注意が必要です・・・

/* * 3.フォルダーの下にメールアイテムが存在します */

パターン的にアカウント--フォルダー--メールアイテムって感じで探っていきます。 アカウントは、今回手抜きで、 objNAMESPC.Folders(1)と1番上のアカウントとして、 その下の受信トレイを探し(objNAMESPC.Folders(1).Folders(n)を探す) そのフォルダー内のメールアイテムを探ってみます。
Sub bbb()
    '受信トレイを探し、メールの件名などを表示してみる
    'Outlookを開き、フォルダー名をメッセージボックスでテスト表示
    Dim objOL      As Object 'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim objFLD     As Object 'フォルダー保存用
    Dim objMAIL    As Object 'メールアイテム
    Dim y As Integer     'カウンター

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの下、第二階層.Foldersでループさせる
    For Each objFLD In objNAMESPC.Folders(1).Folders
        'フォルダー名が受信トレイか?
        If objFLD.Name = "受信トレイ" Then
            'テストでメールを新規ブックに書き出す
            Workbooks.Add   '新規ブックを作成する
            y = 1 '1行目から書き込む
            'フォルダーのアイテム数分ループ Folders.Items
            For Each objMAIL In objFLD.Items
                'セルに代入
                Cells(y, "A") = objMAIL.CreationTime  '作成日
                Cells(y, "B") = objMAIL.Subject
                Cells(y, "C") = objMAIL.Body
                'セット位置を移動
                y = y + 1
            Next objMAIL
        End If
    Next objFLD

    '後始末
    objOL.Quit

End Sub
ポイントは、 For Each objFLD In objNAMESPC.Folders(1).Folders Next このループで、フォルダー(トレイ)をobjFLDに1つ1つ取り出しながらループさせます 次に、取り出したオブジェクトobjFLDの名前が受信トレイかチェックします。 If objFLD.Name = "受信トレイ" Then と、.Nameプロパティを比較します。 フォルダー(トレイ)のItem数分(メールアイテム)を取り出すループを 'フォルダーのアイテム数分ループ Folders.Items For Each objMAIL In objFLD.Items Next と作成しました。このループでobjFLDのアイテム単位に処理してます。 あとは、テストなので、アイテムの内容を 'セルに代入 Cells(y, "A") = objMAIL.CreationTime '作成日 Cells(y, "B") = objMAIL.Subject Cells(y, "C") = objMAIL.Body セルに代入しました。 テストプログラムでなんとなくイメージはつかめましたか? 受信トレイを.Nameを手がかりにフォルダーのループから探し、 その下のメールアイテム .Itemsから1件1件処理してます。

/* * 4.リストボックスに作成日、件名をセットする */

やっとメールアイテムまでたどり着けたので、 このアイテムに対してフラグを書き換えてみたいと思います。 と、その前に、データを選択しないといけないなぁ。 Excelのユーザーフォームを1つ作成して、リストボックスで選ばせるかな。 lstMAIL 1つ、リストボックスを作成 btnSET , btnCLOSE ボタンを2つ作成 フォームを開いたタイミングで、 受信トレイの作成日時と件名をリストボックスにセットする。 リストボックスを選択後、btnSETボタンを押す ボタンが押されたら、該当するメールアイテムを再度検索して、フラグをセット btnCLOSEが押されたらフォームを閉じる、そんな処理を書いてみます。 まず、フォームが開かれたら、 Outlookの受信トレイからメールアイテムを取り込みます。
Private Sub UserForm_Initialize()
    'フォームの初期化イベントでリストボックスにメールデータをセットする
    Dim objOL      As Object 'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim objFLD     As Object 'フォルダー保存用
    Dim objMAIL    As Object 'メールアイテム

    Dim strWORK As String

    Me.lstMAIL.Clear  '.Clearでリストボックスの内容を全てクリア

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの下、第二階層.Foldersでループさせる
    For Each objFLD In objNAMESPC.Folders(1).Folders
        'フォルダー名が受信トレイか?
        If objFLD.Name = "受信トレイ" Then
            'フォルダーのアイテム数分ループ Folders.Items
            For Each objMAIL In objFLD.Items
                '作成日:題名で文字列を作成する
                strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject
                'データをセット
                Me.lstMAIL.AddItem (strWORK)
            Next objMAIL
        End If
    Next objFLD

    '後始末
    objOL.Quit

End Sub
ポイントは特に無く(オイオイ) リストボックスを.Clearでクリアして、.AddItemで行を追加してます。 objMAIL.CreationTime & ":" & objMAIL.Subject 作成日:件名をリストボックスにセットしてます。(1つのカラムにセットしてます) リストボックスの参考URLは Excel UserForm リストボックスを使ってみた http://www.ken3.org/vba/backno/vba121.html を見てください。 ここからメインかな、 フラグをセットのボタンが押されたら、 ^^^^^^^^^^^^^^ リストボックスで選択されている 作成日:題名 と一致するメールアイテムのフラグを書き換えます。
Private Sub btnSET_Click()
    'ボタンが押されたらリストボックスで選択されている
    'メールアイテムのフラグに実施済みの文字をセットする
    Dim objOL      As Object 'OutLookのアプリケーションオブジェクト
    Dim objNAMESPC As Object '名前空間
    Dim objFLD     As Object 'フォルダー保存用
    Dim objMAIL    As Object 'メールアイテム

    Dim strWORK As String

    'アプリケーションのオブジェクトを新規作成
    Set objOL = CreateObject("Outlook.Application")
    
    'Namespace オブジェクト作成
    Set objNAMESPC = objOL.GetNamespace("MAPI")
   
    'フォルダーの下、第二階層.Foldersでループさせる
    For Each objFLD In objNAMESPC.Folders(1).Folders
        'フォルダー名が受信トレイか?
        If objFLD.Name = "受信トレイ" Then
            'フォルダーのアイテム数分ループ Folders.Items
            For Each objMAIL In objFLD.Items
                '作成日:題名で文字列を作成する
                strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject
                'リストボックスとデータが一致するかチェック
                If Me.lstMAIL.Text = strWORK Then
                    'フラグデータをセット(書き換える)
                    objMAIL.FlagStatus = 2 'olFlagMarked (2)をセット参照設定時は定数で
                    objMAIL.FlagRequest = "実施済み" 'フラグ内容をセット
                    'objMAIL.FlagDueBy = Now '今回は期限はセットしない
                    objMAIL.Save  '忘れずに保存する
                    MsgBox "フラグメッセージを書き換えました"
                    Exit For 'ループを強制的に抜ける
                End If
            Next objMAIL
        End If
    Next objFLD

    '後始末
    objOL.Quit

End Sub
ほとんど、リストボックスの初期化と同様の処理で、 受信トレイを探してから、メールアイテムのループに入り、 strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject If Me.lstMAIL.Text = strWORK Then で、リストボックスと文字が一致するかチェックしてます。 一致してたら、フラグのセットです objMAIL.FlagStatus = 2 'olFlagMarked (2)をセット参照設定時は定数で objMAIL.FlagRequest = "実施済み" 'フラグ内容をセット 'objMAIL.FlagDueBy = Now '今回は期限はセットしない objMAIL.Save '忘れずに保存する ステータスに2、フラグ有りをセットしてから文字列で内容"実施済み"をセットします そして忘れずに.Saveメソッドを発行して、保存します(私は忘れて小一時間悩みました) メールのフラグ関係詳細は、 No.161 Outlook VBAでフラグ作成 .FlagStatus .FlagRequest .FlagDueBy http://www.ken3.org/vba/backno/vba161.html を見てください。 最後におまけの閉じるボタン
Private Sub btnCLOSE_Click()
    Unload Me   '自分自身を閉じます(笑)
End Sub
閉じるボタンの参考URLは Excel Form 閉じる方法 Unload Me http://www.ken3.org/vba/backno/vba061.html を見てください。

/* * 5.終わりの挨拶 */

今回は、 受信トレイの受信済みメールに対して、フラグをセットしてみた、 そんな話でした。 フォームを開いた時に全てのメールをリストボックスに代入してますが、 実際は、フラグがセットされていないメールのみをセットするのがよかったり。 ※テストファイル作り終わってから気が付いたり・・・ 'フォルダーのアイテム数分ループ Folders.Items For Each objMAIL In objFLD.Items '作成日:題名で文字列を作成する strWORK = objMAIL.CreationTime & ":" & objMAIL.Subject 'データをセット Me.lstMAIL.AddItem (strWORK) '←※1 Next objMAIL ※1を If objMAIL.FlagRequest <> "実施済み" Then Me.lstMAIL.AddItem (strWORK) End If と、 実施済み以外をリストで選択可能とすると便利かも。 ~~~~~~~~~~~~ また、リストボックスで件名をクリックするとメールの内容が確認できたりしないと、 (リストボックスをクリックしたら、メールの中身を表示するなど) 不親切かなぁと思ったり。 いろいろとボロがあるサンプルですが、 http://www.ken3.org/vba/lzh/vba171.lzh にサンプルvba171.xlsを圧縮しておきます、 Excel2000とOutlook2000版ですが使ってみてください。 三流君VBAでOutlookを操作する http://www.ken3.org/cgi-bin/group/vba_outlook.asp ↑にVBA Outlook 操作系のメルマガまとめてます、こちらも一口どうぞ。 ※今回、かなりの複合技だったけど、1つ1つはなれれば簡単かなぁ。 全体的に斬新なテクニック系のネタじゃないのですが、 何か、感じ取ってくれると、うれしいです。 AB型の変わり者、三流プログラマーのKen3でした。

No.172 2005/05/11
StrConv関数のvbNarrow変換に似た処理 全角ABCを半角ABCへ変換する
[ページTOPへ戻る]

<StrConv関数のvbNarrow変換に似た処理 全角ABCを半角ABCへ変換する>

どうも、三流プログラマーのKen3です。 今回は、 StrConv関数のvbNarrow変換に似た処理を作ってみます

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

http://h17-may.sazae.jp/Buy-Rakuten/Day09.html で、書籍の売れ筋ランキングを紹介してます。 ※儲かる、儲からないは今回は置いといて(でも自慢するくらい売りたいなぁ〜) Windows Server 2003 Network とか、 タイトルが全角の英数字になってます。 ^^^^^^^^^^^^^^^^^^^^ これを半角の Windows Server 2003 Network にしたいです。

/* * 2.関数の仕様 */

文字列を渡したら、半角にした文字列を返してくれる、 そんな関数を作成して下さい。 アナタならどんな依頼をしますか? 値を返すんだから、Function 関数にして、
Function 全角ABCtoABC(strMOTO As String) As String
   Dim strRET As String
   '変換する
      'ここの処理をヨロシクデス、
   '変換結果を返す
   全角ABCtoABC = strRET     'リターン値の代入(変換結果の代入)
End Function
と入出力を書いて、中身の処理をお願いするかな。

/* * 3.標準関数のStrConv関数を使えよボケ */

お願いされたほうは(仕様を渡されたプログラマーは)、 仕様にしたがって処理を作成します。 思考の流れとしては、 文字列の変換で有名なのは、 StrConv関数なので、こいつを使ってみますか。 おっ、vbNarrowってパラメータが使えそうですね。 StrConv 関数の定数 vbNarrow 文字列内の全角文字 (2 バイト) を半角文字 (1 バイト) に変換します。 国別情報の設定が中国、韓国、および日本の場合に適用されます。 これなら、関数自分で作らないでもいいじゃん。 標準関数のStrConv関数使えよボケって感じだよね。 ちっ、あの先輩とはあまり話したくないからメールでも送るかな。 ※派遣先の企業によってはメッセンジャーでやってたり、  メッセンジャー系は禁止になってたり、会社の方針ってイロイロだけど。  オイオイ違うだろ、口で報告しろって!!!(笑)仲良く仲良く・・・ ---- 先ほどの文字列変換関数の件ですが、 VBAの標準関数でStrConv関数があり、 StrConv("文字列", vbNarrow) で変換することができます。
Sub test()
    Dim strWORK As String
    strWORK = "Windows Server 2003 Network"
    MsgBox StrConv(strWORK, vbNarrow)
End Sub
---- よし、これでOK。 タバコ休憩しながら携帯のメールでもチェックするかな。今日の遊びの予定は・・・ 実行結果↓

/* * 4.全角のカタカナは変換したくないんですが・・・・ */

今16時かぁ、定時までの1時間はWebでも見て遊んでいるかな。 クソ三流プログラマーのページでも見て時間つぶすかな。 http://www.ken3.org/ ↑AB型の変わり者 三流プログラマー Ken3のHP なんて考えながら席に戻ると先輩からの新着メールが、 ---- To:プログラマー君 From:説明ベタSE StrConv関数で変換するとカタカナまで半角となり、 html上で使用するのでカタカナを抜いて半角としてほしい Windows デバイスドライバ入門 をテストで変換してみました。
Sub test()
    Dim strWORK As String
    strWORK = "Windows デバイスドライバ入門 "
    MsgBox StrConv(strWORK, vbNarrow)
End Sub
以上、対応よろしく。 ---- 実行結果↓ ↑デバイスドライバが半角カタカナとなってしまった。

/* * 5.だったら初めから言えよ オレ様は悪くない */

はぁ〜、なんだこのメールは・・・理解に苦しむ。 だったら初めから言えよ、変な例題出してんじゃねぇよ。 Windows デバイスドライバ入門 を Windows デバイスドライバ入門 に 変換したいと初めから言えよ。 仕様の出し方、依頼の仕方が悪いんだよ。だからオレ様は悪くない。 ちっ、しかたねぇ、プランを変更するか。 1文字単位で回して、ASC関数でコードの比較をして、変換してやるか。 ABCABCのコードをチェック http://www.ken3.org/cgi-bin/test/test052-1.asp?DATA=%82%60%82a%82bABC 1文字目は[A] をAscで変換すると-32160 さらにHexで16進数にすると8260 2文字目は[B] をAscで変換すると-32159 さらにHexで16進数にすると8261 3文字目は[C] をAscで変換すると-32158 さらにHexで16進数にすると8262 4文字目は[A] をAscで変換すると65 さらにHexで16進数にすると41 5文字目は[B] をAscで変換すると66 さらにHexで16進数にすると42 6文字目は[C] をAscで変換すると67 さらにHexで16進数にすると43 abcabcのコードをチェック http://www.ken3.org/cgi-bin/test/test052-1.asp?DATA=%82%81%82%82%82%83abc 1文字目は[a] をAscで変換すると-32127 さらにHexで16進数にすると8281 2文字目は[b] をAscで変換すると-32126 さらにHexで16進数にすると8282 3文字目は[c] をAscで変換すると-32125 さらにHexで16進数にすると8283 4文字目は[a] をAscで変換すると97 さらにHexで16進数にすると61 5文字目は[b] をAscで変換すると98 さらにHexで16進数にすると62 6文字目は[c] をAscで変換すると99 さらにHexで16進数にすると63 012012のコードをチェック http://www.ken3.org/cgi-bin/test/test052-1.asp?DATA=%82O%82P%82Q012 1文字目は[0] をAscで変換すると-32177 さらにHexで16進数にすると824F 2文字目は[1] をAscで変換すると-32176 さらにHexで16進数にすると8250 3文字目は[2] をAscで変換すると-32175 さらにHexで16進数にすると8251 4文字目は[0] をAscで変換すると48 さらにHexで16進数にすると30 5文字目は[1] をAscで変換すると49 さらにHexで16進数にすると31 6文字目は[2] をAscで変換すると50 さらにHexで16進数にすると32 こんな感じで、Aの次はB,0の次は1と文字コードが計算で求められるので、 全角のA〜Z,a〜z,0〜9の時だけ半角にしますか。
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
Sub test()
    Dim strWORK As String
    strWORK = "Windows 2003 デバイスドライバ入門 "
    MsgBox 全角ABCto半角ABC(strWORK)
End Sub
こんな感じで、 Windows 2003 デバイスドライバ入門 を Windows 2003 デバイスドライバ入門 に変換できたよ、文句無いだろこれで。 プログラムのポイント? 特に無いな・・・あまり考えないでやっつけ仕事です。 Select Case 文字コード Case Asc("0") To Asc("9") '文字コードが全角0〜9 と判断して、strRET = strRET & StrConv(strCHK, vbNarrow)としただけです。

/* * 6.ドットやカッコ・・・スラッシュ・ハイフンも・・・ */

ここまで読むと読者の人はたぶん、 次ぎの展開が読めてしまうと思いますがしつこく行きます Excel VBA(ブイビーエー) 2000/2002/2003対応 .NETエンタープライズWebアプリケーション開発技術大全(vol.2) これも変換したいんだけど・・・ 今日は時間切れ、これから女の子と作者(Ken3)は飲み会 ※ウソです、意外と長編になったので、続きは次回、近日中に・・・

/* * 7.終わりの挨拶 */

今回は、 全角ABCを半角ABCへ変換する そんな話でした。 次回に含みを持たせつつ、今回も逃げるように失礼します。 AB型の変わり者、三流プログラマーのKen3でした。

No.173 2005/05/18
プログラムの修正・追加のいろいろな方法?開発の進め方?
[ページTOPへ戻る]

<プログラムの修正・追加のいろいろな方法?開発の進め方?>

どうも、三流プログラマーのKen3です。 今回は、 プログラムの修正・追加のいろいろな方法? について、少し書いてみます。 自分でも読み返すとあまり参考にならないのですが、 せっかく書いたので発行しちゃいます。 (読者の声:そんなことしてるから、最近のメルマガの質が落ちてるんだってば)

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

前回のメルマガで、 全角英数字を半角にする下記のサブルーチンを作成した。
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
Sub test()  'テスト確認用
    Dim strWORK As String
    strWORK = "Windows 2003 デバイスドライバ入門 "
    MsgBox 全角ABCto半角ABC(strWORK)
End Sub
ところが、このプログラムだと、下記のデータで不具合が発生した テストデータ: "Excel VBA(ブイビーエー) 2000/2002/2003対応" や ".NETエンタープライズWebアプリケーション開発技術大全(vol.2)" 結果: ()/.が半角とならない ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

/* * 2.原因と対策を立てる */

プログラマーの言い分 ------ はぁ〜 "Excel VBA(ブイビーエー) 2000/2002/2003対応" や ".NETエンタープライズWebアプリケーション開発技術大全(vol.2)" で 結果: ()/.が半角とならない ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ だと・・・ 原因はクソSEがテストデータ/テスト仕様書で "Windows 2003 デバイスドライバ入門 " しか渡さないからでしょ。 関数名もぷっ[全角ABCto半角ABC]だって(笑)、 ここからカッコやドットの変換をするんだと読み取れって? もっとまともな仕様を書けよ、オレ様が作ってやるから ---- あらら・・・かなり言われちゃってますね、 人間関係悪い!! ^^^^^^^^^^^^^^^^ なんてのは置いといて、 まず、全体的な原因は仕様の不足って感じですね。 次にプログラム的な原因は、 ()/. の変換処理が抜けているので、この処理を追加すれば直ります。 まぁ、追加の方法はいろいろとあるんだけど。

/* * 3.B君 外側に追加 Replace関数でリターン値を置き換える */

プログラマーA君との相性が悪いので(オイオイ) 日頃から飲みに連れてってかわいがっているB君に修正を依頼した。 A君が作ったプログラムに ()/. も半角に変換する処理を追加してくれよ B君はA君に気を使い、 えっと、A→A,a→a,9→9はできているから、 付け足して、最後にReplaceで変換しますか。 テストプログラムと追加修正したモジュール
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま+する
        End Select
    Next n

    '追加で()/.を変換する
    strRET = Replace(strRET, "(", "(") 'カッコ
    strRET = Replace(strRET, ")", ")")
    strRET = Replace(strRET, "/", "/") 'スラッシュ
    strRET = Replace(strRET, ".", ".") 'ドット

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
Sub test()
    Dim strWORK As String
    Debug.Print "テスト結果:" & Now
    strWORK = "Excel VBA(ブイビーエー) 2000/2002対応"
    Debug.Print 全角ABCto半角ABC(strWORK)
    strWORK = ".NETエンタープライズWebアプリケーション開発技術大全"
    Debug.Print 全角ABCto半角ABC(strWORK)
End Sub
テスト結果: Excel VBA(ブイビーエー) 2000/2002対応 .NETエンタープライズWebアプリケーション開発技術大全 バカくさいけど、 ある一部の処理はできているんだから、 外側に追加してみました。 A君が作った処理も尊重しつつ気を使って修正しました。 ※全部修正するとA君の面子もあるしね・・・

/* * 4.C君 途中に判断を追加する(Case文を追加する) */

さてと、面白そうだからC君にも同じ修正を頼むかな A君が作ったプログラムに ()/. も半角に変換する処理を追加してくれよ C君は素直に、 えっと、A→A,a→a,9→9の判断ができているので、 Case 文を付け足して変換てみます。 テストプログラムと追加修正したモジュール
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
                
            Case Asc("(")             '( カッコ
                strRET = strRET & "("  '半角の(を+する
            Case Asc(")")             ') カッコ
                strRET = strRET & ")"  '半角の)を+する
            Case Asc("/")             '/ スラッシュ
                strRET = strRET & "/"  '半角の/を+する
            Case Asc(".")             '.ドット
                strRET = strRET & "."  '半角の.を+する
            
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
Sub test()
    Dim strWORK As String
    Debug.Print "テスト結果:" & Now
    strWORK = "Excel VBA(ブイビーエー) 2000/2002対応"
    Debug.Print 全角ABCto半角ABC(strWORK)
    strWORK = ".NETエンタープライズWebアプリケーション開発技術大全"
    Debug.Print 全角ABCto半角ABC(strWORK)
End Sub
修正方法としては、 Case Asc("(") '( カッコ strRET = strRET & "(" '半角の(を+する と、各文字を判断して、リターン値のstrRET変数に追加しました。

/* * 5.やっぱりダメか?何も考えないでプログラムを作りやがる */

同僚のSEに愚痴をこぼす。 ( 愚痴系↓みたいなネタですが、お許しを http://www.ken3.org/guchi/ --- プログラマー関係の話を混ぜて語る本人の愚痴 ) やっぱりダメかアイツらは、言われた通りしかプログラムを修正しない。 えっ、別にそれでいいんじゃない?その為の仕様書でしょ? まぁ、聞いてよ。別に怒った訳、イヤミを言うつもりはないんだけど、 >原因はクソSEがテストデータ/テスト仕様書で >"Windows 2003 デバイスドライバ入門 " >しか渡さないからでしょ。 > >関数名もぷっ[全角ABCto半角ABC]だって(笑)、 >ここからカッコやドットの変換をするんだと読み取れって? >もっとまともな仕様を書けよ、オレ様が作ってやるから なんて言われたから売り言葉に買い言葉、逆切れには逆切れで、 君達は、VBAやVB.NETしか知らないと思うけど世の中には、 Visual C#.NETプログラミング入門 とか Microsoft Visual C++ .NETランゲージリファレンス なんて感じで、C#やC++って言語が存在するんだよ それに対して書籍が数点出ているの、VBよりは数量売れていないかもしれないけど、 職業プログラマーの君達は聞いたこと無かったの? ABC君一斉に:そんなの仕様書に載ってないでしょチャント仕様書書いてくださいよ うるせえなぁ、どこまで細かく仕様書書けばいいんだよそれくらい読み取れよ。 作りながら疑問に思わないの?その他変換する文字種類は無いのか?と・・・ ストップ、もうやめなどっちもどっちだよ、聞きたくない。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

/* * 6.部分から全体を読むのは不可能、作らなくても全体や背景も見せる */

なんで醜い争いが発生するのか? 仕様書の不備だけじゃなくで進め方にも問題があったり。 プログラムやシステムは、必要だから作ります。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ その最小単位のモジュールも当然必要だから作ります。 なぜ?必要か? どこで?使用するのか? どんな場面で使用するのか? 全体像や背景も説明すると 仕様書の行き違いがあっても作業者から質問が来てカバーできると思う。 全角英数字を半角にする と仕様書に一言書いておくだけじゃなく、 その背景、 http://h17-may.sazae.jp/Buy-Rakuten/Day18.html ↑書籍の売れ筋ランキングを紹介するhtmlで、 Windows Server 2003 Network とか、 タイトルが全角の英数字になってます。 ^^^^^^^^^^^^^^^^^^^^ これを半角の Windows Server 2003 Network にしたいです と一言、背景や全体像の説明があると、 たとえ仕様書に不備があっても、 作業者から、AtoZ,0to9以外の文字は変換しなくてもいいのですか? など、仕様書に対する疑問も沸いて来ると思う。 ↑なんて考えはもしかしてシステム屋的じゃないのかもしれないね、、、  プログラマーの技量、読解力に頼って仕様書の不備を原因としないのは・・間違い?

/* * 7.終わりの挨拶 */

今回は、 プログラムの追加・修正方法? そんな話でした。 プログラム作りは ^^^^^^^^^^^^^^^^ テクニックなのか? それとも 人の心なのか??? なんか、後半違う話にスリカワッテイルケドご勘弁を。 まぁ、人それぞれ、十人十色、百社百色だけどね。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 次回に含みを持たせつつ、今回も逃げるように失礼します。 AB型の変わり者、三流プログラマーのKen3でした。

No.174 2005/05/25
プログラムの修正 縦に羅列 と 配列で操作
[ページTOPへ戻る]

<プログラムの修正 縦に羅列 と 配列で操作>

どうも、三流プログラマーのKen3です。 今回は、 プログラムの修正・追加のいろいろな方法? として、 縦に羅列と配列でループ を比べて少し書いてみます。 自分でも読み返すとあまり参考にならないのですが、 せっかく書いたので発行しちゃいます。 読者の声:あっ、そのネタ知ってるよ。内容は・・・だろ? ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ またまたぁ・・・先に心の中でネタ先読みしないでよ。 私が最近、金曜日の夜に見ているドラマ タイガー アンド ドラゴンの客じゃないんだからさ -- 余談 -- 落語を元ネタにして、よくできたドラマだと思う。 話の作り方とかテンポの切り替え方、落語のネタと現在の話の混ぜ方が絶妙かなぁ。 脚本家がすごいんだろうなぁ。 私のメルマガでもテンポの切り替え方とか取り入れたいけど・・・ と言いつつ、チョイ役の売れない洋服屋の女性店員がタイプで見てたり(笑)

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

前回のメルマガ No.173 プログラムの修正・追加のいろいろな方法? http://www.ken3.org/vba/backno/vba173.html で、 下記の全角英数字を半角にする下記のサブルーチンを作成した。
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+

            Case Asc("(")             '( カッコ
                strRET = strRET & "("  '半角の(を+する
            Case Asc(")")             ') カッコ
                strRET = strRET & ")"  '半角の)を+する
            Case Asc("/")             '/ スラッシュ
                strRET = strRET & "/"  '半角の/を+する
            Case Asc(".")             '.ドット
                strRET = strRET & "."  '半角の.を+する
            
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
ところが、このプログラムだと、下記のデータで不具合が発生した
Sub test()
    
    Dim strWORK As String
    Debug.Print "テスト結果:" & Now
    
    '2005-05-18 テスト
    strWORK = "Excel VBA(ブイビーエー) 2000/2002対応"
    Debug.Print 全角ABCto半角ABC(strWORK)
    
    strWORK = ".NETエンタープライズWebアプリケーション開発技術大全"
    Debug.Print 全角ABCto半角ABC(strWORK)
    
    '2005-05-25 テスト
    strWORK = "Visual C#.NETプログラミング入門"
    Debug.Print 全角ABCto半角ABC(strWORK)
    
    strWORK = "Microsoft Visual C++ .NETランゲージリファレンス"
    Debug.Print 全角ABCto半角ABC(strWORK)

End Sub
テストデータ: ~~~~~~~~~~~~~ Visual C#.NETプログラミング入門 とか Microsoft Visual C++ .NETランゲージリファレンス を変換すると、C#やC++の#と+がまだ変換されていなかった。

/* * 2.素直に縦に羅列して修正する */

ハイハイ、#と+と□(スペース)の変換を足せばいいんだろ。 ほらよ、CASE文の条件を増やしてやったよ。
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
                
            Case Asc("(")             '( カッコ
                strRET = strRET & "("  '半角の(を+する
            Case Asc(")")             ') カッコ
                strRET = strRET & ")"  '半角の)を+する
            Case Asc("/")             '/ スラッシュ
                strRET = strRET & "/"  '半角の/を+する
            Case Asc(".")             '.ドット
                strRET = strRET & "."  '半角の.を+する
            
            '2005-05-25 条件追加
            Case Asc("#")             '#シャープ
                strRET = strRET & "#"  '半角の#を+する
            Case Asc("+")             '+プラス
                strRET = strRET & "+"
            Case Asc(" ")             '□(全角スペース)
                strRET = strRET & " "  '半角のスペースを+する
            
            Case Else  'その他
                strRET = strRET & strCHK  '上記以外はそのまま+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
これで、文句無いだろ。 他にも文字が発生してきたら、 '2005-05-25 条件追加 Case Asc("#") '#シャープ strRET = strRET & "#" '半角の#を+する Case Asc("+") '+プラス strRET = strRET & "+" Case Asc(" ") '□(全角スペース) strRET = strRET & " " '半角のスペースを+する みたいに、修正すればいいんだよ。 行動は素直じゃないのに、 プログラムは単純に書くよねキミ達は? まぁ動けば何でもいいんだけどね、文句も無いけど言ってみただけ。

/* * 3.配列にしてループで回してみた。 */

久々にムカっと来た。 少し先に生まれたからって(少し先に入社したからって)偉そうにするんじゃねぇよ。 だったら配列で変換する文字を管理して、ループで回してやるよ。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    '2005-05-25 追加
    Dim str全角(8) As String
    Dim str半角(8) As String
    Dim nLOOPCNT As Integer   'ループのカウンタ

    '配列に文字をセットする
    str全角(0) = " ": str半角(0) = " " '□(全角スペース)
    str全角(1) = "(": str半角(1) = "(" '( カッコ
    str全角(2) = ")": str半角(2) = ")" ') カッコ
    str全角(3) = "/": str半角(3) = "/" '/ スラッシュ
    str全角(4) = ".": str半角(4) = "." '.ドット
    str全角(5) = "#": str半角(5) = "#" '#シャープ
    str全角(6) = "+": str半角(6) = "+" '+プラス
    str全角(7) = "−": str半角(7) = "-" '−マイナス、ハイフン

    strRET = "" 'リターン値の初期化
   
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Else  'その他
                '配列の文字と一致するかチェックする 2005-05-25修正
                For nLOOPCNT = 0 To 7
                    If strCHK = str全角(nLOOPCNT) Then  'チェックする全角文字と一致するか?
                        strCHK = str半角(nLOOPCNT)  '対応する半角文字をセットする
                        Exit For  'ループを強制的に抜ける
                    End If
                Next nLOOPCNT
                strRET = strRET & strCHK  'strCHKを+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
こんな感じで、始めに配列に str全角(0) = " ": str半角(0) = " " '□(全角スペース) str全角(1) = "(": str半角(1) = "(" '( カッコ str全角(2) = ")": str半角(2) = ")" ') カッコ str全角(3) = "/": str半角(3) = "/" '/ スラッシュ str全角(4) = ".": str半角(4) = "." '.ドット str全角(5) = "#": str半角(5) = "#" '#シャープ str全角(6) = "+": str半角(6) = "+" '+プラス str全角(7) = "−": str半角(7) = "-" '−マイナス、ハイフン とデータをセットして、 For nLOOPCNT = 0 To 7 If strCHK = str全角(nLOOPCNT) Then 'チェックする全角文字と一致するか? strCHK = str半角(nLOOPCNT) '対応する半角文字をセットする Exit For 'ループを強制的に抜ける End If Next nLOOPCNT ループで回してチェックして、一致したら置換する感じです。

/* * 4.配列の初期化にArray関数使ってみたら? */

配列の初期化で str全角(0) = " ": str半角(0) = " " '□(全角スペース) str全角(1) = "(": str半角(1) = "(" '( カッコ と縦に書くのかぁ・・・ これはこれでわかりやすいけど、Array関数を使ってみたら? Array関数使えよ と どれだけの読者が心に思ったか?興味があるけど、 まず、 Dim str全角 As Variant '*1 変数をVariantで宣言 Dim str半角 As Variant とVariant型で変数を宣言してから、 str全角 = Array(" ", "(", ")", "/", ".", "#", "+", "−") str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-") こんな感じ?で使用します。※配列を作成できます。 あまり変化無いけど、こんな感じで初期化文を書くことができたので、
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    '2005-05-25 追加
    Dim str全角 As Variant '*1 変数をVariantで宣言
    Dim str半角 As Variant
    Dim nLOOPCNT As Integer   'ループのカウンタ

    'Array関数で配列を初期化する
    str全角 = Array(" ", "(", ")", "/", ".", "#", "+", "−")
    str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-")
    
    strRET = "" 'リターン値の初期化
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Else  'その他
                '配列の文字と一致するかチェックする 2005-05-25修正
                For nLOOPCNT = 0 To 7
                    If strCHK = str全角(nLOOPCNT) Then  'チェックする全角文字と一致するか?
                        strCHK = str半角(nLOOPCNT)  '対応する半角文字をセットする
                        Exit For  'ループを強制的に抜ける
                    End If
                Next nLOOPCNT
                strRET = strRET & strCHK  'strCHKを+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
でも、あんまり変わらないね・・・ -- 補足宣伝 -- 配列とArray関数 http://www.ken3.org/vba/backno/vba008.html も見てね。

/* * 5.配列の要素数(MAXの数)を知るのにUBound関数を使ってみたら? */

配列の初期化でArray関数を説明したら次はアレだろ? と 心の中で文句を言われていた読者の方、お待たせしました。 心に浮かんだ関数、UBound関数で当りです。 Array関数を使用して修正を簡単に作っているのですが、 'Array関数で配列を初期化する str全角 = Array(" ", "(", ")", "/", ".", "#", "+", "−") str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-") 例えばこれに、 *(アスタリスク)を追加します。 まぁ、後ろに追加するだけなんだけど 'Array関数で配列を初期化する str全角 = Array(" ", "(", ")", "/", ".", "#", "+", "−","*") str半角 = Array(" ", "(", ")", "/", ".", "#", "+", "-", "*") これだけだと、修正が足りなかったり。 えっ、どこが?全角と半角、追加しとるよ。 ※見難いけど(醜いけど)順番は間違っていないよ せっかく追加したのに、下記のループのカウンタ '配列の文字と一致するかチェックする 2005-05-25修正 For nLOOPCNT = 0 To 7 If strCHK = str全角(nLOOPCNT) Then 'チェックする全角文字と一致するか? strCHK = str半角(nLOOPCNT) '対応する半角文字をセットする Exit For 'ループを強制的に抜ける End If Next nLOOPCNT ここが、0から7のままだと・・・あっ、やられましたね。 ここを1文字増えたので8にしないと。 そこで知りたいのが配列の要素の数、 Array関数やSplit関数で作成された配列の要素数を知るのに便利なUBound関数 UBound(変数名)で配列のサイズ、数を返してくれます。 ^^^^^^^^^^^^^^ For nLOOPCNT = 0 To UBound(str全角) と使用してループを作成すればOKです。 -- 補足宣伝 -- 関数に汎用性を持たせる、共通に使える関数作り http://www.ken3.org/vba/vba-hanyo.html Split関数とUBound関数のサンプルを解説 http://www.ken3.org/cgi-bin/test/test024-2.asp ArrayとUboundで項目名を管理してWhere句を作成 http://www.ken3.org/cgi-bin/test/test093-2.asp も見てね。

/* * 6.一文字探すんだったら文字列からInStr関数でいいんじゃないの? */

ここまで読んだ読者の感想を予想すると、 一文字探すんだったら文字列からInStr関数でいいんじゃないの? ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ※心の中で文句を言われていた読者の方、お待たせしました。 (オイオイ、待ってないって?) 配列を作成して、 For nLOOPCNT = 0 To UBound(str全角) If strCHK = str全角(nLOOPCNT) Then 'チェックする全角文字と一致するか? strCHK = str半角(nLOOPCNT) '対応する半角文字をセットする Exit For 'ループを強制的に抜ける End If Next nLOOPCNT と 配列内に該当する文字があったら、自分で置換してましたが、 この処理を 配列内を0からループで探す そんな考え方 から 文字列の中から該当する文字(1文字)を探す に 方針を変更してみたいと思います。 文字列から文字列を探す場合、便利なInStr関数があります。 この関数を使って修正してみます。
Function 全角ABCto半角ABC(strMOTO As String) As String
    Dim strRET As String
    Dim strCHK As String
    Dim n As Integer
    Dim lngCODE As Long
    
    '2005-05-25 追加
    Dim str全角 As String
    Dim str半角 As String
    Dim nSERCH  As Integer  '場所を覚える変数

    '全角の文字列と半角の文字列を作成する
    str全角 = " ()/.#+−*"
    str半角 = " ()/.#+-*"
    
    strRET = "" 'リターン値の初期化
    '文字数分コードを調べて変換して、strRETに+する
    For n = 1 To Len(strMOTO)
        strCHK = Mid(strMOTO, n, 1)  'n番目の文字を取り出す
        Select Case Asc(strCHK)
            Case Asc("0") To Asc("9") '全角0〜9
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("a") To Asc("z") '全角a〜z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Asc("A") To Asc("Z") '全角A〜Z
                strRET = strRET & StrConv(strCHK, vbNarrow) '変換して+
            Case Else  'その他
                '変換候補の変数 str全角の中に存在するか?チェックする 2005-05-25修正
                nSERCH = InStr(str全角, strCHK)  'InStr関数でstr全角からstrCHKを探す
                If nSERCH > 0 Then  '見つかった、場所が0以上か?
                    strCHK = Mid(str半角, nSERCH, 1)  '半角のn番目を代入する(に置き換える)
                End If
                
                strRET = strRET & strCHK  'strCHKを+する
        End Select
    Next n

    '変換結果を返す
    全角ABCto半角ABC = strRET     'リターン値の代入(変換結果の代入)
End Function
まず、全角と半角の文字列を用意します。 '全角の文字列と半角の文字列を作成する str全角 = " ()/.#+−*" str半角 = " ()/.#+-*" ※↑文字の順番を間違えないでね・・・(一文字でもずれるとシャレニならないよ) 次にチェック対象の全角文字が存在するか探します。 nSERCH = InStr(str全角, strCHK) 'InStr関数でstr全角からstrCHKを探す If nSERCH > 0 Then '見つかった、場所が0以上か? strCHK = Mid(str半角, nSERCH, 1) '半角のn番目を代入する(に置き換える) End If strRET = strRET & strCHK 'strCHKを+する もし、みつかると、nSERCHに位置が返ります。 nSERCH > 0 だったら、対応する半角の文字をstrCHKにセットして(置き換えます) 変数をわかりやすく見えるようにするとこんな感じかな? str全角 = " ()/.#+−*" str半角 = " ()/.#+-*" strCHK = "/" だと、 nSERCH = InStr(" ()/.#+−*", "/") で、 nSERCHには、4が入る。 で、>0なので、 strCHK = Mid(" ()/.#+-*", 4, 1) '半角のn番目を代入する(に置き換える) と、 strCHKは、/が代入され、 strRET = strRET & "/" 'strCHKを+する で、無事に半角となる。(半角を&でつなげた文字列が作成される)

/* * 7.終わりの挨拶 */

今回は、 配列とループ、 そんな話でした。 プログラム作りは ^^^^^^^^^^^^^^^^ う〜ん・・・ まぁ、人それぞれ、十人十色、百社百色だけどね。 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 次回に含みを持たせつつ、今回も逃げるように失礼します。 AB型の変わり者、三流プログラマーのKen3でした。


検索して目的の情報を探す。

目的の情報を探すには、最近はググれとよく聞きます。なので、検索ボックスを付けました。
いろいろなキーワードを入れて、検索してみてください。

カスタム検索
三流君(site:www.ken3.org) 内を Googleを利用してキーワード する

ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。

質問や要望など メッセージを送る(三流君に連絡する)

質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
あなたのお名前(ニックネーム):さん
返信は?: 不用(HP更新を待つ) , E-mail→ アドレス:に返事をもらいたい



(感想や質問・要望 メッセージはHPで記事に載せることがあります。)

急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。

リンクや広告など

項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。
人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記3つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

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

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

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

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

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

Blog:[三流君の作業日記]/ [サンプルコードのゴミ箱]/ 広告-[通販人気商品の足跡]



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