業務で使えるシリーズ（マクロ：メールアンケート）

メールでアンケート結果を収集する必要がありました。
Excelで実施して欲しい手順を展開し、手順の最後でお名前とメールアドレスを入力していただき、ポチっと押して貰うと
収集している人にメールが送信されるというマクロを作成してみました。

ご紹介させていただきます。

Sub SendMail()

On Error Resume Next

team = Sheets(1).Range("G65").Value
Uname = Sheets(1).Range("G67").Value
sendusername = Sheets(1).Range("G69").Value

'メール送信にSMTPサーバを使用しているので、場合によってはパスワードが必要となる
'が、今回はパスワードを設定せずにメール送信が可能な環境のためにコメントアウト

'sendpassword = Sheets(1).Range("G71").Value

If sendusername = "" Then
   MsgBox "メールアドレスを入力して再度実行してください。"
   Exit Sub
End If

Set objMail = CreateObject("CDO.Message")

objMail.From = sendusername
objMail.To = "メール収集者のメールアドレス"
objMail.Subject = "メールの件名（Subject）"
objMail.TextBody = "メール本文"

strConfigurationField = "http://schemas.microsoft.com/cdo/configuration/"
With objMail.Configuration.Fields
   .Item(strConfigurationField & "sendusing") = 2
   .Item(strConfigurationField & "smtpserver") = "SMTPサーバ"
   .Item(strConfigurationField & "smtpserverport") = 25
   .Item(strConfigurationField & "smtpusessl") = True
   .Item(strConfigurationField & "smtpauthenticate") = 1
   .Item(strConfigurationField & "sendusername") = sendusername
   '.Item(strConfigurationField & "sendpassword") = sendpassword
   .Item(strConfigurationField & "smtpconnectiontimeout") = 60
   .Update
End With

objMail.Send

If Err.Number <> 0 Then
 MsgBox "メール送信に失敗しました。" 
ElseIf Err.Number = 0 Then
 MsgBox "メール送信が完了しました。"
End If

Set objMail = Nothing


End Sub