完成図やヒントを見て、ステップメールのVBAプログラムを作成する課題はできましたか?
出来た人は、プログラミングの実力がアップしています。
出来なかった人も、一度は自分の頭で考えてから解答例を見ることをおすすめします。
考えずに解答だけ見ると、理解度が全く違ってくるからです。
今回紹介する解答例は、正解の一つに過ぎません。プログラムにはいろんな書き方があるので、もしあなたが書いた方法で、ステップメールが送信できているなら、それも正解の一つです。
それでは解答例を掲載します。
追加・変更のあったプロシージャのみ掲載しているので、ご注意ください。変更の無いプロシージャはそのまま使えるので、ここには掲載していません。
Option Explicit
Dim svname As String
Dim id As String
Dim pass As String
Dim mSender As String '送信者
Dim mailq As String 'メールキュー
Dim logfile As String 'ログファイル
Dim startPos As Long '開始行番号
Dim endPos As Long '終了行番号
Dim maxStep As Long '最大ステップ
Private Sub cmd送信_Click()
'エラーが発生したら処理を行なう
On Error GoTo Err_Shori
Dim bobj As Object
Dim mailto As String
Dim mailfrom As String
Dim subj As String
Dim body As String
Dim msg As Variant 'メール作成チェック用
Dim rc As Integer '一括送信チェック用
Dim i As Long
Dim tName As String
Dim eMail As String
'行番号の値をチェック
If endPos < startPos Then
Me.lblMsg = "終了行番号は、開始行番号以上の値を入力してください。"
'フォーカスを移す
Me.txtEndPos.SetFocus
'メール送信ボタン使用不可
Me.cmd送信.Enabled = False
Exit Sub
End If
'未入力の項目が無いかチェック
For i = startPos To endPos
'ワークシートの値を取得
tName = Trim(Range("A" & i).Value)
eMail = Trim(Range("B" & i).Value)
If tName = "" Or eMail = "" Then
Me.lblMsg = "行番号" & i & "にデータが未入力の項目があります。"
'フォーカスを移す
Me.txtEndPos.SetFocus
'メール送信ボタン使用不可
Me.cmd送信.Enabled = False
Exit Sub
End If
Next i
'オブジェクトを作成
Set bobj = CreateObject("basp21")
'メールアドレスが有効かチェック
Dim match As Integer
Dim target As String
Dim regstr As String
regstr = "/^[\w\-+\.]+\@[\w\-+\.]+$/i"
For i = startPos To endPos
'ワークシートの値を取得
eMail = Trim(Range("B" & i).Value)
target = eMail
match = bobj.match(regstr, target)
If match = 0 Then
Me.lblMsg = "行番号" & i & "のメールアドレスが正しくありません。"
'メール送信ボタン使用不可
Me.cmd送信.Enabled = False
Exit Sub
End If
Next i
'文章を取得して配列にセットする
Dim textArray() As String '動的配列
ReDim textArray(1 To maxStep) '要素数を設定
Dim titleArray() As String
ReDim titleArray(1 To maxStep)
Dim filePath As String
For i = 1 To maxStep
'ワークシートの値を取得
filePath = Trim(Sheets("文章").Range("B" & i + 1).Value)
titleArray(i) = Trim(Sheets("文章").Range("C" & i + 1).Value)
'文章を配列にセット
textArray(i) = readTextFile(filePath)
Next i
'送信者
mailfrom = mSender & vbTab & id & ":" & pass
'件名取得
subj = Me.txtSubject
'本文取得
body = Me.txtBody
Dim tmpSubj As String
Dim tmpBody As String
Dim files As String
Dim nextStep As Long
'開始~終了行番号のメールを作成
For i = startPos To endPos
'次のステップ
nextStep = CLng(Trim(Range("C" & i).Value)) + 1
'最大ステップ数以下の場合
If nextStep <= maxStep Then
'ワークシートの値を取得
tName = Trim(Range("A" & i).Value)
eMail = Trim(Range("B" & i).Value)
'宛先
mailto = eMail
'件名を一時変数に代入
tmpSubj = subj
'件名に自動挿入
tmpSubj = Replace(tmpSubj, "[氏名]", tName)
tmpSubj = Replace(tmpSubj, "[タイトル]", titleArray(nextStep))
'本文を一時変数に代入
tmpBody = body
'本文に自動挿入
tmpBody = Replace(tmpBody, "[氏名]", tName)
tmpBody = Replace(tmpBody, "[文章]", textArray(nextStep))
'添付ファイル
files = Trim(Range("F" & i).Value)
files = Replace(files, ";", vbTab)
'メール作成
msg = bobj.SendMail(mailq, mailto, mailfrom, tmpSubj, tmpBody, files)
'作成チェック
If msg <> "" Then
MsgBox "行番号" & i & "のメールで作成エラー。" & vbCrLf & msg, vbOKOnly + vbCritical, "作成時エラー"
'送信用フォルダをクリアする
If Dir(mailq & "\*.txt") <> "" Then
Kill mailq & "\*.txt"
End If
Exit Sub
Else
Me.lblMsg = "行番号" & i & "のメールを作成しました。"
End If
End If
Next i
Me.lblMsg = "メール送信開始・・・"
'メール一括送信
rc = bobj.FlushMail(svname, mailq, logfile)
'送信チェック
If rc <= -1 Then
MsgBox "送信できませんでした。" & vbCrLf & "エラー:" & rc, vbOKOnly + vbCritical, "送信時エラー"
ElseIf rc = 0 Then
MsgBox "送信に該当するメールがありませんでした。", vbOKOnly + vbInformation, "情報"
Else
'送信に成功したら、ステップアップする
updateStep
MsgBox rc & "件のメールを送信しました。", vbOKOnly + vbInformation, "完了"
End If
'ラベルをクリア
Me.lblMsg = ""
Err_Shori_Exit:
Exit Sub
'ここからエラー処理
Err_Shori:
MsgBox Err.Description, vbOKOnly + vbCritical, "実行時エラー"
Resume Err_Shori_Exit
'ここまで
End Sub
Private Sub txtMaxStep_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'エラーが発生したら処理を行なう
On Error GoTo Err_Shori
'メール送信ボタン使用不可
Me.cmd送信.Enabled = False
'最大ステップが空白の時の処理
If Me.txtMaxStep = "" Then
Me.lblMsg = "最大ステップを入力してください。"
Cancel = True
Exit Sub
End If
'最大ステップを取得
maxStep = CLng(Me.txtMaxStep)
'最大ステップが1未満の時の処理
If maxStep < 1 Then
Me.lblMsg = "最大ステップは、1以上の数値を入力してください。"
Cancel = True
Exit Sub
End If
'ラベルをクリア
Me.lblMsg = ""
'メール送信ボタン使用可
Me.cmd送信.Enabled = True
Err_Shori_Exit:
Exit Sub
'ここからエラー処理
Err_Shori:
MsgBox Err.Description, vbOKOnly + vbCritical, "実行時エラー"
Cancel = True
Resume Err_Shori_Exit
'ここまで
End Sub
Private Sub UserForm_Initialize()
'メール送信ボタン使用不可
Me.cmd送信.Enabled = False
'初期値
Me.txtStartPos = 2
Me.txtEndPos = 2
Me.txtMaxStep = 10
startPos = 2
endPos = 2
maxStep = 10
'送信者
mSender = Trim(Sheets("設定").Range("B1").Value)
'SMTPサーバー
svname = Trim(Sheets("設定").Range("B2").Value)
'送信ID
id = Trim(Sheets("設定").Range("B3").Value)
'送信パスワード
pass = Trim(Sheets("設定").Range("B4").Value)
'メールキュー
mailq = "C:\mailPG\Send"
'ログファイル
logfile = "C:\mailPG\logfile.txt"
End Sub
Private Sub updateStep()
'ステップ更新
Dim i As Long
Dim nextStep As Long
For i = startPos To endPos
'次のステップ
nextStep = CLng(Trim(Range("C" & i).Value)) + 1
'最大ステップ数以下の場合
If nextStep <= maxStep Then
'ステップアップ
Range("C" & i).Value = nextStep
End If
Next i
End Sub
【動作確認】
プログラミングを行なう時には、動作確認しながらの試行錯誤が欠かせません。
(1)動作確認の手順は、前回の Step55・課題3 ステップメールを送信する の「完成図」と同じ要領です。
(2)メールの送信が上手くいくと、ステップが自動的に更新されることも確認してください。
また、最大ステップを超えるメールは送信されないことも確認してください。ワークシート「送信」のステップに10以上を指定すると、送信されません。
(3)プログラムについては、Step56、Step57のヒントを参考にしてください。
【ワンポイント】
今回はステップメールを送信する前に、タイトルと文章をあらかじめ配列に格納しました。
この方法は、送信するメール数に対し、文章数が少ない時に有効です。あらかじめデータを用意しておくことで、処理が速くなります。(ただしメモリーは消費する)
逆に文章数のほうが多く、メール数が少ない場合には、使わない文章まで読み込んでおくと無駄になります。
そのような場合には、メールを作成する時に、必要な文章だけ読み込むという手もあります。
どちらの方法が良いのかは、システムの使い方によって変わります。