|
Option Explicit
Declare Function SendMail Lib "bsmtp" _
(szServer As String, szTo As String, _
szFrom As String, szSubject As String, szBody As String, szFile As String) As String
Sub MySendMail()
Dim ret As String
Dim szLogfile As String
Dim szServer As String, szTo As String, szFrom As String
Dim szSubject As String, szBody As String, szFile As String
Dim flBody
Dim i As Long
Dim fs, a As Object
On Error GoTo Err_Handler
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\log.txt", True)
' メール送信結果を記録するファイル名を指定します。
szServer = Worksheets("本文").Cells(11, 1) ' SMTPサーバ名
'
With Worksheets("宛名及び置換文字")
If .Cells(1, 3) & .Cells(1, 7) = "" Then
MsgBox "タイトルとFROMを入力してください"
GoTo Exit_sub
Else
If MsgBox("タイトル:" & .Cells(1, 3) & "、送信元" & .Cells(1, 7) & "で良いですか?", _
vbOKCancel, "確認") = vbCancel Then
GoTo Exit_sub
End If
End If
szSubject = .Cells(1, 3) ' 件名
szFrom = .Cells(1, 7) ' 送信元
i = 3
Do While .Cells(i, 1) <> "END"
If .Cells(i, 1) = "○" Then
szTo = .Cells(i, 5) ' 宛先
szBody = .Cells(i, 6) ' 本文
szFile = ""
ret = SendMail(szServer, szTo, szFrom, szSubject, szBody, szFile)
If Len(ret) <> 0 Then
a.WriteLine (Date & " " & Time & " " & ret & "−" & szTo & "−" & szBody)
'MsgBox "エラー" & ret & "−" & .Cells(i, 4)
.Cells(i, 1) = "エラー"
Else
.Cells(i, 1) = "完了"
End If
End If
i = i + 1
Loop
End With
' パラメータエラーのときは、戻り値にエラーメッセージが返ります。
MsgBox "終了"
GoTo Exit_sub
Err_Handler:
MsgBox Err.Description, vbCritical, "Error"
GoTo Exit_sub
Exit_sub:
a.Close
End Sub Dim flBodyは変数宣言なのですか?この変数はどこで使用されているの でしょうか?
|
|