ステップメールを送信するプログラムの解答例。

Excelからステップメールを送信することができます。

完成図やヒントを見て、ステップメールの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のヒントを参考にしてください。



【ワンポイント】
今回はステップメールを送信する前に、タイトルと文章をあらかじめ配列に格納しました。

この方法は、送信するメール数に対し、文章数が少ない時に有効です。あらかじめデータを用意しておくことで、処理が速くなります。(ただしメモリーは消費する)

逆に文章数のほうが多く、メール数が少ない場合には、使わない文章まで読み込んでおくと無駄になります。

そのような場合には、メールを作成する時に、必要な文章だけ読み込むという手もあります。

どちらの方法が良いのかは、システムの使い方によって変わります。


スポンサードリンク

スポンサードリンク






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