今回は、住所を表示する部分と住所録の［登録］ボタン、［閉じる］ボタンのプログラムを作ってみます。住所を表示するタブのところは、単に表示・入力するだけなのでプログラムを作る必要は無いのですが、今回は、メールをクリックするとメールソフトを起動したり、URLをクリックするとInternet Explorerを起動できるようにしてみたいと思います。
図１４−１
それでは、早速メールをクリックしたときにメールソフトを起動させるプログラムを見てみます。送信したいメールアドレスをダブルクリックすると起動されるようにします。したがってプログラムは[ダブルクリック時］のイベントプロシージャに作ります。
01:'概要：選択されたメールアドレスを判断しメールソフトを立ち上げる
02:Private Sub txt現住所メール_DblClick(Cancel As Integer)
03: Dim strMail As String
04: strMail = fncSelString(Me.txt現住所メール)
05 If strMail = "" Then Exit Sub
06: subSendMail strMail
07:End Sub
現住所のメールは、複数個登録することができるようにしてあります。したがって、どのメールアドレスをクリックしたかを判断する必要があります。そのプログラムが4行目の“fncSelString（）”です。
6行目が得られたメールアドレスをセットしてメールソフトを起動させるプログラムです。
まずは、どのメールアドレスをクリックしたかを判断するプログラムを見てみます。
01:'概要：マルチテキストの内、選択された行の文字列を返す
02:'引数：txtBox：マルチテキストのコテキストボックス
03:Public Function fncSelString(txtBox As TextBox) As String
04: Dim str As String
05: Dim iLen As Integer
06: Dim iStart As Integer
07: Dim iEnd As Integer
08: If txtBox.Text = "" Then
09: fncSelString = ""
10: Exit Function
11: End If
12: iLen = Len(txtBox.Text)
13: iStart = 1
14: Do
15: '文字列の中からvbCrがあるところの文字数を求める
16: iEnd = InStr(iStart, txtBox.Text, vbCr, vbTextCompare)
17: 'vbCrが無い場合
18: If iEnd = 0 Then
19: fncSelString = Mid(txtBox.Text, iStart, iLen)
20: If fncSelString = "" Then
21: fncSelString = str
22: End If
23: Exit Do
24: 'vbCrがある場合
25: Else
26: str = Mid(txtBox.Text, iStart, iEnd - 1)
27: 'マウスをクリックした位置が文字列の範囲内の場合
28: If txtBox.SelStart = 0 Or (iStart <= txtBox.SelStart And txtBox.SelStart < iEnd) Then
29: fncSelString = str
30: Exit Do
31: End If
32: End If
33: iStart = iEnd + 2
34: Loop
35:End Function
16行目の“InStr（）”はある文字列 の中から指定した文字列を検索し、見つかった文字の先頭からその位置まで の文字数を返す文字列処理関数です。つまり、ここでやろうとしていることは、メールアドレス（txtBox.Text）の 指定された文字数（iStart）以降にキャリッジリターン文字(vbCr)がある場所を求めています。テキストモードの 検索ならば“vbTextCompare”ですが、バイナリモードで検索するには、“vbBinaryCompare”にします。
18行目から23行目で“vbCr”が見つからなかったとき、指定された位置（iStart)から最後までの文字列を 返しています。
19行目の“Mid（）”関数は、文字列から指定した文字数分の文字列を返します。ここでは、メールアドレス（txtBox.Text）の指定された位置（iStart)からiLen文字分の文字列を求めています。
25行目から33行目までが“vbCr”が見つかったときの処理です。28行目でマウスのクリックされた位置が文字列の 範囲内にあるかどうかを調べています。“．SelStart”がテキストボックスの中でマウスのクリックされた位置です。 範囲内であればその文字列を返します。
クリックした場所が範囲外の時は次の行に移るように“Ｌｏｏｐ”していますが、その前に33行目“iStart=iEnd+2”と しています。この“＋２”の意味は、実は、“vbCr”の1バイトと“vbLf”の１バイト分の計2バイトを飛ばして 次の文字列の先頭を設定するためのものです。
次のプログラムが実際にメールソフトを起動するためのものです。
01:'概要：メールソフトを起動する 02:'引数：strMailAddress：メールアドレス 03:Public Sub subSendMail(strMailAddress As String) 04: On Error GoTo ERR_subSendMail 05: DoCmd.SendObject , , , strMailAddress 06:ERR_subSendMail: 07:End Sub
5行目が指定したメールアドレスを表示してメールソフトを起動させているところです。ここでは、メールアドレスのみ の指定になっていますが、その他にテーブルを添付してたり、複数の人に送ったり、メッセージ自体を設定することも出来ます。
4行目と6行目は対になっています。メールソフトを起動させて送信処理をする前に終了した場合、エラーが発生してしまいます。 そのエラーを無視するようにするためにこのようにしています。「“On Error GoTo”でここから先にエラーが生じた場合“ERR_subSendMail”というラベルまで飛びなさい。」という意味です。6行目以降はプログラムの終了になっているため、何も処理がされずに プログラムを抜けていきます。
この住所録データベースでは、ほとんど実行時のエラー処理を行っていませんが、通常プログラムを作成するときは、 必ずエラーが発生したときのことを考えてそれを回避する処理を入れておきます。ここでは、エラーが起こっても何も処理を しませんが、何かしらの処理を加えて再度実行しなおすようなことも出来ます。重要なデータの更新を行うような場合、何個所かにこれを設定しておいて、どこでエラーが発生したかを明確にし、データの更新を無効にしたり、また、正常に終わるようにメッセージを表示したりします。
次は、会社のメールアドレスをダブルクリックしたときの処理です。中身は、現住所のメールアドレスをクリックしたのと ほとんど変わりませんが、会社の場合、メールアドレスのテキストボックスは1行しか入らないように設定しているため、 その分プログラムがシンプルになっています。
'概要：メールソフトを立ち上げる
Private Sub txt会社メール_DblClick(Cancel As Integer)
If Me.txt会社メール.Text = "" Then Exit Sub
subSendMail Me.txt会社メール.Text
End Sub
次に“ＵＲＬ”をダブルクリックしたら“Ｉｎｔｅｒｎｅｔ Ｅｘｐｌｏｒｅ”を起動するプログラムを見てみましょう。 これは、現住所の場合も会社の場合もＵＲＬのテキストボックスの名前が違うだけなので現住所のプログラムのみを見てみます。
01:'概要：ＩＥを開く 02:Private Sub txt現住所URL_DblClick(Cancel As Integer) 03: If Me.txt現住所URL.Text = "" Then Exit Sub 04: subOpenIE txt現住所URL.Text 05:End Sub4行目が“Internet Explorer”を開くプロシージャです。中身を見ましょう。
01:'概要：Internet Explorerを起動する
02:Public Sub subOpenIE(Navi As String)
03: Dim IE As Object
04: Set IE = CreateObject("InternetExplorer.Application")
05: If IE Is Nothing Then
06: MsgBox "Internet Explorerがインストールされておりません", vbCritical
07: Exit Sub
08: End If
09: IE.navigate "http://" & Navi
10: IE.Visible = True
11:End Sub
4行目がミソです。この“CreateObject（）”というのは、他のアプリケーションを実行するときに使います。 ただし、どんなアプリケーションもこの方法で実行できるわけではありません。WordやExcelなどマイクロソフトのアプリケーション ならば、まず問題なく実行できますが、そうでない場合は、“CreateObject”の変わりに“Shell”関数を使います。
5行目で“InternetExplorer”のオブジェクトが設定されたかどうかを調べています。設定されていない場合は、 メッセージを出して終了しています。オブジェクト変数の場合、設定されているかどうかを調べるのは、“Null”ではなくて “Nothing”になります。
6行目の”Msgbox”がそのエラーメッセージです。後の”vbCritical”はメッセージボックスに”×”マークを表示させる物です。 そのほかにも、［Yes］ボタンや[Cancel]ボタンなども表示させることが出来ます。
9行目でホームページアドレスを設定して、10行目で“InternetExplorer”を表示しています。
先ほど、メールソフトを起動させるのに“DoCmd.SendObject”を使いましたが、メールソフトが“Outlook Express”や “Microsoft Outlook”ならば、この“CreateObject”を使って起動させることも出来ます。
会社住所タブの中で、メールとＵＲＬ以外でプログラムが設定されているものは、会社名と部署名のです。 会社名と部署名を入力した段階で自動的に会社に関連した 住所や電話番号などを表示するようにします。次が会社名と部署を入力した後のプログラムですが、既に出てきたものばかりですので説明はいらないでしょう。
'概要：会社名と部署名からその会社の住所を表示して会社のＩＤを求める
Private Sub cmb会社名_AfterUpdate()
Dim strSql As String
If IsNull(Me.cmb会社名) Then
Me.txt会社ID = Null
Else
Me.txt会社ID = fncViewCompanyAddress(Me, , Me.cmb会社名, Me.cmb部署)
If IsNull(Me.txt会社ID) Then
subClearCompanyAddress Me
End If
strSql = fncSetDepRowSource(Me.cmb会社名)
End If
Me.cmb部署.RowSource = strSql
Me.cmb部署.Requery
End Sub
'概要：会社名と部署名からその会社の住所を表示して会社のＩＤを求める
Private Sub cmb部署_AfterUpdate()
Me.txt会社ID = fncViewCompanyAddress(Me, , Me.cmb会社名, Me.cmb部署)
If IsNull(Me.txt会社ID) Then
subClearCompanyAddress Me
End If
End Sub
次は、実家住所タブの中にある[現住所コピー］ボタンのプロシージャです。現住所に表示してある内容をそのまま実家住所にコピーしてきます。
'概要：現住所を実家住所にコピーする
Private Sub btnAddressCopy_Click()
Me.txt実家郵便番号 = Me.txt現住所郵便番号
Me.txt実家住所1 = Me.txt現住所住所1
Me.txt実家住所2 = Me.txt現住所住所2
Me.txt実家番地 = Me.txt現住所番地
Me.txt実家電話 = Me.txt現住所電話
Me.txt実家FAX = Me.txt現住所FAX
End Sub
以上が住所を表示するタブ内のプログラムです。
［登録］ボタンの処理を説明する前に簡単な［閉じる］ボタンの内容を見てみましょう。
01:'概要：この画面を閉じでメニュー画面を表示します。 02:Private Sub btn閉じる_Click() 03: DoCmd.OpenForm "メニュー" 04: DoCmd.Close acForm, "個人情報入力" 05:End Sub
3行目で“メニュー“を表示して、４行目でこの“個人情報入力”フォームを閉じています。
さて、いよいよ［登録］ボタンの処理に入ります。データベースを更新する場合、必要な情報がちゃんと設定されているか、矛盾が発生しないかなどを考えながらプログラムを作らなければなりません。
01:'概要：この入力フォームに表示されている内容を各テーブルに保存します。
02:Private Sub btn登録_Click()
03: Dim db As Database
04: Dim blInput As Boolean
05: If IsNull(Me.txt姓) Then
06: MsgBox "苗字を入力してください。", 16
07: DoCmd.GoToControl "txt姓"
08: Exit Sub
09: End If
10: '会社情報の確認
11: If fncCheckCompanyInf(Me) = False Then Exit Sub
12: Set db = CurrentDb()
13: '個人情報の登録
14: subUpIndividual db
15: '現住所の登録
16: subSetPresentAddress db
17: '会社情報の登録
18: If Not IsNull(Me.cmb会社名) Then
19: If IsNull(Me.txt会社ID) Then
20: Me.txt会社ID = Nz(DMax("会社ID", "会社情報")) + 1
21: End If
22: subSetCompanyInfo db, Me
23: End If
24: '会社の個人情報を登録する
25: subSetCompanyIndividual db, Me
26: '実家住所の登録
27: subSetParentsAddress db
28: '家族テーブルの更新
29: subModFamilyTable db
30: Me.txt個人ID.SetFocus
31: Me.frm名簿sub.Requery
32: MsgBox "登録しました", vbInformation
33:End Subこの住所録では必ず苗字を入力することにしています。そのため、入力されていなかったらメッセージを出して、処理を終了させます。その処理が５行目から９行目です。ついでにエラーを起こしている入力項目にフォーカスを移動させておくと入力が簡単になります。７行目でフォーカスを移動させています。
ちなみに、この７行目をVBっぽく書くならば、３０行目の“me.txt姓.SetFocus”です。この命令に限らずAccessでは、同じ処理をするにもかかわらず、違う書き方をするものがたくさんあります。どちらでも問題ありませんが、他の処理のことを考えるとVBと同じ書き方になれていた方が、自由度が増すと思います。
１１行目以降は、プログラムを呼び出しているだけですので後でそれぞれ説明します。
２０行目は、“txt会社ID”にデータをセットしています。“Nz()”は、括弧内が“Null”のとき“０”を返す関数です。“DMax()”は、最大値を求める関数です。 DMax("会社ID", "会社情報")で“会社情報”テーブルの中の”会社ID”の最大値を求めています。初めてデータを入力するときは，データが存在しないため最大値は、存在しません。つまり“Null” が帰ってきます。そこで“Nz”関数で値を“０”にします。それに＋１します。 これで、常に新しい最大の番号を付けることが 出来ます。
１１行目の“fncCheckCompanyInf”は会社の情報がテーブルに登録できる条件を満たしているかどうかをチェックしているプログラムです。次のようになっています。住所や代表電話番号などが入力されているにもかかわらず会社名が入力されていない場合は、エラーにしています。
'概要：会社情報を登録することができるかチェックする。
Public Function fncCheckCompanyInf(frm As Form) As Boolean
Dim blInput As Boolean
fncCheckCompanyInf = False
blInput = False
If Not IsNull(frm.txt会社代表電話) Then blInput = True
If Not IsNull(frm.txt会社FAX) Then blInput = True
If Not IsNull(frm.txt会社URL) Then blInput = True
If Not IsNull(frm.txt会社郵便番号) Then blInput = True
If Not IsNull(frm.txt会社住所1) Then blInput = True
If Not IsNull(frm.txt会社番地) Then blInput = True
If Not IsNull(frm.txt会社住所2) Then blInput = True
If blInput = True And IsNull(frm.cmb会社名) Then
MsgBox "会社名が登録されておりません", vbCritical
frm.cmb会社名.SetFocus
Exit Function
End If
fncCheckCompanyInf = True
End Function
とりあえず、今回は、ここまでにしておきます。次回から実際に各情報をそれぞれのテーブルに更新するプログラムを説明します。
(佐藤）まで電子メールでお送りください。
ただし、添付ファイルがある場合は、内容を確認せずに削除させて頂いておりますのでご了承ください。