PeaceJetのブログ

金融系の社内エンジニアをやりながら、マーケティングやプランナーなども

VBAでメールを送信する方法

VBAでメールを送信するには?

こんにちは、PeaceJetです。

「エクセルでセルの内容をメール出来ないか?」といったニーズがありまして・・・ちょっと書いてみたいと思います。

メールを送る際には、本来なら自前のサーバーを送りたいところなのですが、「メールアカウント」「サーバーアドレス」「ポート番号」・・・「そんなの、良く分からない!」という方もいると思います。

そこで、GMailを利用してメールを送る方法を考えてみたいと思います。

つまり、「エクセルからGmailを送信する」ということになります。

CDOライブラリの読み込み

CDOとは、Microsoft Collaboration Data Objects (CDO)の略です。

 Windows 2000/XP/Server 2003には、CDO(Collaboration Data Objects)と呼ばれるメッセージング・コンポーネント(CDOSYS.DLL)が標準で搭載されており、これをWSHWindows Script Host)スクリプトから利用すれば、スクリプトからのメール送信が可能になる。

Tech TIPS:Windows標準機能とWSHを使ってメールを送信する - @IT

そこで、CDOライブラリを使用できるようにVBエディタから設定を変更します。

「ツール」→「参照設定」と進み、以下のライブラリにチェックを入れて下さい。


f:id:PeaceJet:20160927183549j:plain

※ これを一度オンにしておけば、どのパソコンで開いても当該ライブラリが使用できるようになります。

Gmail側のセキュリティ設定を変更

Gmailを送信する際に、使ってGmailを送信する場合、Gmail側でセキュリティ設定を変更する必要があるようです。

Googleアカウントでログインし、「安全性の低いアプリを許可」ページを開くと、以下の画面が出てきますので、「有効にする」にチェックを入れてください。

f:id:PeaceJet:20160927200452j:plain

プログラム

メールを送信するプロシージャ。
Public Sub Mail送信()
  SendGmail "(Googleアカウント)@gmail.com", _
            "(Googleアカウントのパスワード)", _
            "(Toアドレス)", _
            "(Ccアドレス)", _
            "(Bccアドレス)", _
            "件名:メール送信テスト", _
            "本文です。" & vbCrLf & "テストします" & vbCrLf & "これは、テストです", _
End Sub
メールを送信するための機能を実装したプロシージャです。
Private Sub SendGmail( _
ByVal AccountAddress As String, _
ByVal AccountPassword As String, _
ByVal MailTo As String, _
ByVal MailCc As String, _
ByVal MailBcc As String, _
ByVal MailSubject As String, _
ByVal MailBody As String)

Const cdoBasic = 1
Const cdoSendUsingPort = 2
Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPUseSSL = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
  
  With CreateObject("CDO.Message")
    
    .From = AccountAddress
    
    .To = MailTo
    
    If Len(Trim(MailCc)) > 0 Then .CC = MailCc
    
    If Len(Trim(MailBcc)) > 0 Then .BCC = MailBcc

        .Subject = MailSubject

    If Len(Trim(AttachmentFilePath)) > 0 Then .AddAttachment AttachmentFilePath

    With .Configuration.Fields
      .Item(cdoSendPassword).Value = AccountPassword
      .Item(cdoSendUserName).Value = AccountAddress
      .Item(cdoSendUsingMethod).Value = cdoSendUsingPort
      .Item(cdoSMTPConnectionTimeout).Value = 100
      .Item(cdoSMTPAuthenticate).Value = cdoBasic
      .Item(cdoSMTPServer).Value = "smtp.gmail.com"
      .Item(cdoSMTPServerPort).Value = 465
      .Item(cdoSMTPUseSSL).Value = True
      .Update
    End With

    On Error Resume Next

    .Send

    If Err.Number <> 0 Then
    
      MsgBox "エラーが発生しました。" & vbCrLf & _
             "エラー番号:" & Err.Number & vbCrLf & _
             "エラー内容:" & Err.Description, vbCritical + vbSystemModal
    
    End If
    
    On Error GoTo 0
  
  End With
  
End Sub

www.ka-net.org

こちらを参考にさせていただきました。