【VBA】ユーザー目線で開発する５

目次

ユーザーフォームとAccessDBでツール作成

一日に2ℓくらい水を飲むjimです。どうも✋

今回は、、というか、今回もかな？

【VBA】ユーザー目線で開発する４の続きです。

『ユーザーが使いやすいように、ユーザーフォームで開発。そして、参照先は全てAccessにしてみよう。』ってことだったんだけど、長くなったね😆

この５回で最後にするつもりですが、実は山ほど書きたいことはある。。。

はい、というわけで⇒

ユーザーフォーム追加

同一ファイルにユーザーフォームを追加します。

新しくユーザーフォームを挿入して、下図のようにコマンドボタンを配置します。

オブジェクト名はそのままです。

Userform2にCommandButton1とCommandButton2が並んでいるだけです。

登録フォーム

CommandButton2から実装します。

以下の内容をUserform2に記述します。

1С (Запрос)
1
2
3
Private Sub CommandButton2_Click()
    UserForm1.Show
End Sub

単純に登録用のフォームを表示させるだけです。

メール作成機能

CommandButton1の機能を実装します。

最初に参照設定を行います。

Outlookのライブラリにチェックを入れます。

↓のライブラリは古いです。（MicrosoftOutlook○○ObjectLibraryにチェック）

次に、メールの本文に使うデータを問い合わせる関数を作成します。

Userform1の初期化とほぼ一緒です。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub CommandButton1_Click()
Dim mailStr(3) As String
    Call GetUser(mailStr(0), mailStr(1), mailStr(2), mailStr(3))
End Sub
 
Private Sub GetUser(ByRef mailStr0, mailStr1, mailStr2, mailStr3 As String)
Const dbname = "\\共有サーバー\適当.accdb"
Dim adoCn, adoRs As Object
Dim sqlStr As Object
Dim WshNetworkObject As Object
Dim userName As String
    Set WshNetworkObject = CreateObject("WScript.Network")
    userName = WshNetworkObject.userName
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbname & ";"
    sqlStr = "SELECT * FROM 個人設定 WHERE ユーザー名 ='" & userName & "' ;"
    adoCn.Open sqlStr, adoCn
    If adoRs.EOF = True Then
        If IsNull(adoRs!名字) = False Then mailStr0 = adoRs!名字
        If IsNull(adoRs!名前) = False Then mailStr1 = adoRs!名前
        If IsNull(adoRs!保存先) = False Then mailStr2 = adoRs!保存先
        If IsNull(adoRs!メールアドレス) = False Then mailStr3 = adoRs!メールアドレス
    End If
    adoRs.Close
    adoCn.Close
End Sub

これで名字からメールアドレスまで取得できたので、この情報をもとにOutlookのメールを作成します。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Option Explicit
 
Private Sub CommandButton1_Click()
Dim mailStr(3) As String
Dim outlookObject As Outlook.Application
Dim mailObject As Outlook.MailItem
Dim bodyStr As String
    Call GetUser(mailStr(0), mailStr(1), mailStr(2), mailStr(3))
    Set outlookObject = New Outlook.Application
    Set mailObject = outlookObject.CreateItem(olMailItem)
    bodyStr = "○○様" & vbCrLf
    bodyStr = bodyStr & "いつもお世話になっております。"
    bodyStr = bodyStr & mailStr(0) & mailStr(1) & "です。" & vbCrLf
    bodyStr = bodyStr & "保存先：" & mailStr(2) & vbCrLf
    bodyStr = bodyStr & "-------------------------"
    bodyStr = bodyStr & mailStr(0) & mailStr(1) & vbCrLf
    bodyStr = bodyStr & mailStr(3)
    With mailObject
        .To = "gake.com"
        .CC = "gake.com"
        .Subject = "【格納連絡】"
        .Body = bodyStr
        .BodyFormat = olFormatHTML
        .Display
    End With
End Sub
Private Sub GetUser(ByRef mailStr0, mailStr1, mailStr2, mailStr3 As String)
Const dbname = "\\共有サーバー\適当.accdb"
Dim adoCn, adoRs As Object
Dim sqlStr As Object
Dim WshNetworkObject As Object
Dim userName As String
    Set WshNetworkObject = CreateObject("WScript.Network")
    userName = WshNetworkObject.userName
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=" & dbname & ";"
    sqlStr = "SELECT * FROM 個人設定 WHERE ユーザー名 ='" & userName & "' ;"
    adoCn.Open sqlStr, adoCn
    If adoRs.EOF = True Then
        If IsNull(adoRs!名字) = False Then mailStr0 = adoRs!名字
        If IsNull(adoRs!名前) = False Then mailStr1 = adoRs!名前
        If IsNull(adoRs!保存先) = False Then mailStr2 = adoRs!保存先
        If IsNull(adoRs!メールアドレス) = False Then mailStr3 = adoRs!メールアドレス
    End If
    adoRs.Close
    adoCn.Close
End Sub
Private Sub CommandButton2_Click()
    UserForm1.Show
End Sub

これで実装完了です。

メール作成ボタンを押せば、以下のようなメールが作成されるはずです。

（ちなみ、全然テストしてません。エラー出るかも。。。）

 

まとめ

はい、いかがでしたか？

参照先をAccessにすることで、マクロファイルを編集することがなくなりますし読専にすることも可能です。それによって、複数のユーザーが同時に使用可能になります。開くときに邪魔なメッセージも出なくなるので、ユーザーのストレスも減るでしょう。

今回は登録とメール作成の２つ機能をユーザーフォーム実装しましたが、自分は複数の業務を１つのユーザーフォームにモリモリ盛ったりします。

例えば、今回のような登録フォームやカレンダーフォーム。それからラベルを並べてスプレッドシート風にしたり。。。

うん、色々。

ものによってはオブジェクトの数が多すぎて苛々します。

それでも、発想次第では凄く便利なものができるので、皆さんも挑戦してみては？

 

 

あっ、そういえば、今回のやつパワポで作ってたんだけど、パワポはアプリケーションを非表示にできないの忘れてた😓

そうそう、だからWordで作るようにしてたんだった。。。

テヘペロ

Wordなら、ThisDocumentモジュールに以下のコードを記述し、

1С (Запрос)
1
2
3
4
Private Sub Document_Open()
    Application.Visible = False
    UserForm2.Show
End Sub

Userform2に以下のコードを記述する。そうすると、ツール使用時はユーザーフォームだけが表示されるようになります。

1С (Запрос)
1
2
3
4
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Visible = True
    Application.Quit
End Sub

Application.Quitは、Wordだったら開いている全てのWordを・Excelなら開いている全てのExcelを終了してしまうので注意が必要です。

それじゃまたね✋

 

Access,SQL,VBA,データベース,プログラミングVBA

Posted by jim