スポンサードリンク

ステップメールで、送信間隔を設定するプログラムの解答例。

Excelからステップメールを送信するプログラムでは、送信間隔を設定することができます。

これまでに紹介した完成図やヒントを見て、ステップメールのVBAプログラムを改良する課題はできましたか?

出来た人は、プログラミングがかなり上達しています。

出来なかった人も、必ず一度は自分の頭で考えてください。

考えた後にこの解答例を見ることをおすすめします。

自分で考えてみるのと、まったく考えずに解答だけ見るのとでは、理解度が全く違ってくるからです。

今回紹介する解答例は、たくさんある正解の一つに過ぎません。

プログラムには、いろんな書き方があります。

もしあなたが書いた方法で、ステップメールの送信間隔が設定できたなら、それも正解の一つです。

それでは解答例を掲載します。

追加・変更のあったプロシージャのみ掲載しているので、ご注意ください。

変更の無いプロシージャは、そのまま使えるので、ここには掲載していません。

・宣言セクション

Option Explicit

省略
Dim intervalArray() As Integer '送信間隔



・「メール送信」ボタンをクリック時

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)
  
  ReDim intervalArray(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)
    intervalArray(i) = CInt(Trim(Sheets("文章").Range("D" & 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
  Dim lastDate As Date
  Dim nextDate As Date
  
  '開始〜終了行番号のメールを作成
  For i = startPos To endPos
    
    '次のステップ
    nextStep = CLng(Trim(Range("C" & i).Value)) + 1
      
    '最大ステップ数以下の場合
    If nextStep <= maxStep Then
    
      '最終送信日
      lastDate = CDate(Trim(Range("D" & i).Value))
      '次の送信日を計算
      nextDate = lastDate + intervalArray(nextStep)
      
      '送信日がまだの場合
      If nextDate > Now Then
        Exit For
      End If
      
      'ワークシートの値を取得
      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
    '送信に成功したら、ステップと最終送信日を更新する
    updateData
    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 updateData()
  'ステップと最終送信日を更新
  
  Dim i As Long
  Dim nextStep As Long
  Dim lastDate As Date
  Dim nextDate As Date
  
  For i = startPos To endPos
    '次のステップ
    nextStep = CLng(Trim(Range("C" & i).Value)) + 1
    
    '最大ステップ数以下の場合
    If nextStep <= maxStep Then
    
      '最終送信日
      lastDate = CDate(Trim(Range("D" & i).Value))
      '次の送信日を計算
      nextDate = lastDate + intervalArray(nextStep)
      
      '送信日がまだの場合
      If nextDate > Now Then
        Exit For
      End If
      
      'ステップアップ
      Range("C" & i).Value = nextStep
      '最終送信日を更新
      Range("D" & i).Value = Format(Now, "yyyy/mm/dd")
    End If
    
  Next i
  
End Sub



【動作確認】
プログラミングを行なう時には、動作確認しながらの試行錯誤が欠かせません。

動作確認の手順は、「Step60・課題4 送信間隔を設定する」でも説明しています。

以下に動作確認のポイントだけを書いておきます。

(1)Excelワークシート「送信」の最終送信日の値は、ランダムに入力してかまいません。

でも、必ず今日より前の日付にしてください。*重要

それと日付の書式(形式)は守って入力します。*重要


(2)メールの送信が上手くいくと、「ステップ」と「最終送信日」が自動的に更新されることを確認してください。

条件に一致し、送信したメールのデータだけが更新されるはずです。


(3)最大ステップを超える場合、かつ送信日が未だの場合は、メールが送信されないことも確認してください。

ワークシート「送信」のステップに10以上を指定すると、送信されません。
(フォームの最大ステップに10以下を指定した場合)

また最終送信日にステップごとの送信間隔をプラスして、次の送信日を計算し、

もし現在より大きい(未来)だと、まだメールを送信する時期ではないため、送信されません。

つまり条件に一致しないメールは、作成されません。


(4)プログラムの意味については、「Step61・課題4 送信間隔を設定するヒント」を参考にしてください。


いかがでしたか?

あなたの考えたプログラムと合っていましたか。

またはどこが違っていたでしょうか。


上記のプログラムも、プロシージャに分割することで、もっとスッキリ書くことができます。

しかしプログラミング初心者には、上から下に流れるプログラムのほうが理解しやすい(流れを追いやすい)ので、あえてそのままにしています。

余裕のある人は、プロシージャに分割することに挑戦してみるとよいでしょう。

スポンサードリンク






メール送信・受信プログラミング初心者入門 TOPへ