広告 Access

AccessデータベースからEメールを送る（サンプル付き）

2020年6月3日

在庫管理システムを作っていて「【安全在庫】に引っかかる品目が現れたら管理者にEメールを飛ばしたい」と思っていました。
「さすがにAccessからはEメールは送れないだろう」と調べもしておりませんでしたが、できるのですね。
以下のサイトを参考にしてサンプルファイルを作って実行してみましたら、すんなり成功しました。

参考にしたサイト

注意

Biglobeのメールアカウントを利用して自分宛てにメールしてみました。個人情報であるメールアドレスやパスワードは削除してあります。一部smtpサーバーの設定にBiglobeの設定が残っていますが、それは環境に合わせて書き換えの必要があります。メールアドレス・パスワード・宛先・メールサーバーの設定、これらが揃わないとサンプルは動作しません。

在庫管理システムについては⇩

AccessデータベースからEメールを送る（サンプル付き）
めいあんのIT格闘記
2019.09.13
AccessデータベースからEメールを送る（サンプル付き）
簡易的にAccessデータベースで在庫管理システムを作成（サンプル付）
https://meian-blog.net/teck/accessデータベースで在庫管理システムを作成/
必要に迫られてAccessにて在庫管理・在庫検索・入出庫処理・入出庫履歴・在庫転送・単位変換、マスターデータの修正等々を装備したデータベースを構築しました。フォーム（分割フォームやサブフォーム）・クエリ・VBAを使っています。誰かのお役に立てば幸いです。

オーダーメイドの自動管理システムでさまざまな問題を解決！！

AccessデータベースからEメールを送る（サンプル付き）

フォーム

フォームには「送信」のコマンドボタン（コントロール名：cmd_送信）を配置したのみです。
コマンドボタン（cmd_送信）を選択した後、【プロパティシート】-【イベント】タブ-【クリック時】を「イベントプロシージャ」に変え、右横の【…】をクリックしてVBエディタを開きます。

テーブル

テーブルは2つあります。

T_社員

メールアドレス・パスワードの情報が入ったテーブルです。

T_メール送信履歴

送信履歴を残します。「送信日時」と「本文」が格納されています。送信に成功しますと、「可否」がTrueとなり、チェックが入ります。何らかのエラーで送信失敗時はFalseになります。

ここではサンプルですので、実用化するには「宛先」「cc:」「エラーコード」などのフィールドも必要かと思います。

VBAコード

最初の設定

VBエディタを開きましたら、最初に【ツール】-【参照設定】をクリックします。
【Microsoft CDO for Windows 2000 Library】にチェックをしてOKボタンを押します。

コード

フォームのVBAコードは以下の通りです。VBエディタにコピペします。

Option Compare Database

Private Sub cmd_送信_Click()
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("T_メール送信履歴", dbOpenTable)
    
    With rs
        .AddNew
        .Fields("送信日時") = Now
        .Fields("本文") = "本文"
        .Fields("可否") = cdoSendMail
        .Update
    End With
    
    rs.Close
    Set rs = Nothing
End Sub

'------------------------------------------------------------
'   処理内容:CDOメール送信
'   引数:なし
'   戻り値:True/False
'   参考Webサイト：https://asbepartners.com/send_mail/
'------------------------------------------------------------
Public Function cdoSendMail() As Boolean

    Dim objCDO
    Dim MSgw
    
    Dim txtアドレス As String
    Dim txtパスワード As String
    Dim txt社員 As String
    Dim sql As String
    
    Dim rs As DAO.Recordset
    
    sql = "SELECT * FROM T_社員 WHERE 社員コード=" & 10001 'メールする人を選択
    Set rs = CurrentDb.OpenRecordset(sql)
    txtアドレス = rs.Fields("アドレス")
    txtパスワード = rs.Fields("パスワード")

    
    On Error GoTo Err_Exit
    
    '戻り値の初期化
    cdoSendMail = False
      
    Set objCDO = CreateObject("CDO.Message")
    
    'CDOのスキーマを定義
    MSgw = "http://schemas.microsoft.com/cdo/configuration/"
    
    With objCDO.Configuration.Fields
        'メール送信方法
        .Item(MSgw & "sendusing") = 2
        'SMTPサーバーのアドレス
        .Item(MSgw & "smtpserver") = "mail.biglobe.ne.jp" 'Biglobeでテストしました。各自の環境に合わせて要書き換えてください！
        'SMTPサーバーのポート
        .Item(MSgw & "smtpserverport") = 465 'Biglobeでテストしました。各自の環境に合わせて要書き換えてください！
        '差出人ユーザー名
        .Item(MSgw & "sendusername") = txtアドレス
        '認証コード
        .Item(MSgw & "sendpassword") = txtパスワード
        'SSL認証要
        .Item(MSgw & "smtpusessl") = True
        '認証方式(1)
        .Item(MSgw & "smtpauthenticate") = cdoBasic
        'タイムアウト
        .Item(MSgw & "smtpconnectiontimeout") = 60
        .Update
    End With
     
    '差出人メールアドレス
    objCDO.From = txtアドレス
    
    'あて先メールアドレス
    objCDO.To = txtアドレス '管理者のメールアドレスなどに書き換えてください
    
    'CCメールアドレス
    'objCDO.CC = Me.txtCC '必要に応じて書き換えてください
    
    '件名
    objCDO.subject = "送信テスト件名" '必要に応じて書き換えてください
    '本文
    objCDO.textBody = "送信テスト本文" '必要に応じて書き換えてください
    
    '文字化け対応のため追加
    objCDO.TextBodyPart.Charset = "ISO-2022-JP"
     
    objCDO.send
    
    MsgBox "メールを送信しました。", vbOKOnly + vbInformation, "送信完了"
    
    '正常終了
    cdoSendMail = True

    Set rs = Nothing
    rs.Close
    
    Exit Function
    
Err_Exit:
    MsgBox Err.Number & ":" & Err.Description, vbOKOnly + vbCritical, "cdoSendMail()"

End Function

Function cdoSendMailを「フォーム1」の中に書いていますが、各フォーム共通で使用する場合は「標準モジュール」に移動させます。

このFunction内にて「T_社員」テーブルを参照して変数に入れていますが、Function cdoSendMailの引数とすることも可能です。
例えば以下⇩のようにして、呼び出し側から引数を渡してやればこのFunction内から「T_社員」テーブルを参照している処理を削除できます。

Public Function cdoSendMail(txtアドレス As String,txtパスワード as String) As Boolean

注意

Biglobeのメールアカウントを利用して自分宛てにメールしてみました。個人情報であるメールアドレスやパスワードは削除してあります。一部smtpサーバーの設定にBiglobeの設定が残っていますが、それは環境に合わせて書き換えの必要があります。メールアドレス・パスワード・宛先・メールサーバーの設定、これらが揃わないとサンプルは動作しません。

Biglobeメールの場合のSMTP設定

SMTPサーバー：mail.biglobe.ne.jp
SMTPポート：465

Gmailの場合のSMTP設定

SMTPサーバー：smtp.gmail.com
SMTPポート：587

Yahoo!メールの場合のSMTP設定

SMTPサーバー：smtp.mail.yahoo.co.jp
SMTPポート：465

Hotmailの場合のSMTP設定

SMTPサーバー：smtp.live.com
SMTPポート：25

会社のメールアドレスを利用する場合には、IT管理担当者等（サーバー管理者とかネットワーク管理者など会社によって名称は様々です）に情報を求めてください。

余談

試していませんが、Excelでも使用可能だろうと思います。sheet内にボタンを配置してVBAコードを実行させればできるかと思います。

サンプルダウンロード

ファイルを最初に開く際に「コンテンツの有効化」をクリックしてください。

コンテンツの有効化

拡張子を.mdbにしてあります。Access2002以降で開けると思います。

DOWNLOAD　

AccessデータベースからEメールを送る（サンプル付き）

最後に

余計なお節介ですが、

メールのパスワードが入っていますので、ここだけ別のAccessデータベースにし、管理者パスワードを掛けるか、データベースごと暗号化するなどした方がよいかと思います。

また、会社の業務にて使用される場合には、このためだけのメールのアカウントをシステム管理者に発行をお願いすると良いかと思います。

余談ですが、どこの誰かわらない人にEメールのパスワードを特定されてしまい、踏み台にされて大量のスパムメールを全世界に配信されたことがあります。Biglobeから「警告書」が届いて慌ててパスワードを変更した覚えがあります。

-Access
-, ,

Please disable your adblocker or whitelist this site!