Gmalで一覧から一括送信するVBA

Excelの一覧よりメールをGmailで送信したいと考え、他サイト様を色々と参照させてもらいコードを作成したが上手くいかない。CDOを使用するにあたり、Google側のセキュリティ設定「安全性の低いアプリ」の設定を変更し、二段階認証などは突破済み(ログイン状態済み)にしなければいけないらしい?

他SSL通信、ファイアーウォールで引っかかっているのか何なのかで送信ができず、ポートを変更したり等色々試してみてもnot availableで送信できず。

現状では結局どうしても送信できずこちらのマクロは現在中断。(2015.04)一応、現状で実行してみたコードは以下に記しておく。Gmail以外(Outlookメールやhotmailなど)では送信テスト済み。今後原因等が分かり次第更新予定ってことで、とりあえずメモ。

※「Microsoft CDO for windows 2000 Library」というものを参照設定したうえで下記のコードを実行。なにやらCDOを参照するうえで必要らしいので(小並

 

 


コピペ用サンプルコード(不完全)

 

Sub MAIL_Sample_Gmail()

Dim traSchemas, traUserName, traPassword, traFrom, traTo, traCc, traSubject, traBody, traServer, lngPortNo, objMessage

traSchemas = “http://schemas.microsoft.com/cdo/configuration/”
traUserName = Cells(任意のセル).Text ‘googleユーザー名
traPassword = Cells(任意のセル).Text ‘パスワード
traFrom = Cells(任意のセル).Text ‘送信元
traTo = Cells(任意のセル).Text ‘宛先
traCc = Cells(任意のセル).Text ‘宛先CC
traBcc = Cells(任意のセル).Text ‘宛先BCC
traSubject = Cells(任意のセル).Text ‘件名
traBody = Cells(任意のセル).Text ‘本文
traServer = “smtp.gmail.com”
lngPortNo = 465 ’25の場合は認証不要らしい

Set objMessage = CreateObject(“CDO.Message”)
If Err.Number = 0 Then
‘ 認証ありのとき
If traUserName <> “” Then
objMessage.Configuration.Fields.Item _
(traSchemas & “sendusername”) = traUserName
objMessage.Configuration.Fields.Item _
(traSchemas & “sendpassword”) = traPassword
objMessage.Configuration.Fields.Item _
(traSchemas & “smtpauthenticate”) = 1
objMessage.Configuration.Fields.Item _
(traSchemas & “smtpusessl”) = True ‘サポートしていない場合はFalse
End If

objMessage.From = traFrom
objMessage.To = traTo
If traCc <> “” Then
objMessage.Cc = traCc
End If
If traBcc <> “” Then
objMessage.Bcc = traBcc
End If

objMessage.Subject = traSubject
objMessage.TextBody = traBody

objMessage.Configuration.Fields.Item _
(traSchemas & “sendusing”) = 2
objMessage.Configuration.Fields.Item _
(traSchemas & “smtpserver”) = traServer
objMessage.Configuration.Fields.Item _
(traSchemas & “smtpserverport”) = lngPortNo

objMessage.Configuration.Fields.Update
objMessage.Send
If Err.Number = 0 Then
WScript.Echo “メールを送信しました。”
Else
WScript.Echo “メールの送信に失敗しました。” & _
“(” & Err.Description & “)”
End If
Else
WScript.Echo “エラー: ” & Err.Description
blnRetCode = False
End If

Set objMessage = Nothing

End Sub