access vba 行ごとにメール送信　宛先不明時の処理ルーチン

2020/07に投稿した者です。

テーブルに複数行のレコードがあり、メールアドレスや他のカラムがあります。
必要なカラムを一時的に保持してメール本文に代入し、これをCDOでメール送信しています。

リリース前テストの段階でバグに気づきました。

メールアドレスが誤っていると，次のレコードにいかずエラーで終わってしまいます。
（Err_Exit:に移動させているので当たり前）

メールアドレスが誤っていたら送れなかったというログを取得し，次のレコードを
処理して欲しいのですが，知見の浅さからどうにもなりません。

objCDO.Send　でメールサーバーに問い合わせた結果がエラーなので
都度都度問い合わせ結果を取得しなくてはいけない所は理解するのですが。

こういった案件に長けている有識者からの提供をお待ちしております。

Public Function cdoSendMail() As Boolean

Dim objCDO
Dim MSgw

On Error GoTo Err_Exit

'戻り値の初期化
cdoSendMail = True
  
Set objCDO = CreateObject("CDO.Message")

'CDOのスキーマを定義
MSgw = "http://schemas.microsoft.com/cdo/configuration/"

With objCDO.Configuration.Fields
    
'メール送信方法
    .Item(MSgw & "sendusing") = 2
    
    'SMTPサーバーのアドレス
    .Item(MSgw & "smtpserver") = "hoge.hoge.com"
    
    'SMTPサーバーのポート
            
    .Item(MSgw & "smtpserverport") = 465
    
    '差出人ユーザー名
    .Item(MSgw & "sendusername") = "username"
    
    '認証コード
    .Item(MSgw & "sendpassword") = "userpassword"
    
    'SSL認証要
            
    .Item(MSgw & "smtpusessl") = True
    
    '認証方式(1)
    .Item(MSgw & "smtpauthenticate") = cdoBasic
    
    'タイムアウト
    .Item(MSgw & "smtpconnectiontimeout") = 60
    
    .Update
    
End With
 
'差出人メールアドレス

objCDO.From = "sasidasinin@hoge.com"

Dim dbo As DAO.Database 'DAO使用時定型
Dim rst As DAO.Recordset 'DAO使用時定型
Dim sSqlStr As String 'SQL文
Dim sTo As String 'sTO = "宛先のアドレス"


sSqlStr = "SELECT * FROM 該当テーブル"
Set dbo = CurrentDb
Set rst = dbo.OpenRecordset(sSqlStr)

    
Do Until rst.EOF

'あて先メールアドレス
objCDO.To = rst.Fields("メールアドレス")

sTo = rst.Fields("メールアドレス")

'件名
objCDO.Subject = "件名"

'本文

objCDO.TextBody = " " _

& vbNewLine & "一行目"_

& vbNewLine & "二行目"_


'文字化け対応のため追加
objCDO.TextBodyPart.Charset = "ISO-2022-JP"
    
    objCDO.Send


rst.MoveNext

Loop

cdoSendMail = True

rst.Close

dbo.Close

Exit Function

Err_Exit:

MsgBox Err.Number & ":" & Err.Description & vbCrLf, vbOKOnly + vbCritical + vbSystemModal, "メール送信エラー"

End Function

行動規範の内容に同意します

回答1件

ベストアンサー

objCDO.Send　でエラーが出ているのですね。

ならば、その時のエラー番号を調べて、エラー処理でそのエラー番号の時は、Resume Next でエラー行の次の行から再開させればいいでしょう。

vba
1
2'前略
3
4Err_Exit:
5    Select Case Err.Number
6    Case 該当のエラー番号
7        Resume Next
8    Case Else
9        MsgBox Err.Number & ":" & Err.Description & vbCrLf, vbOKOnly + vbCritical + vbSystemModal, "メール送信エラー"
10    End Select
11
12End Function