Dim wslist As Worksheet
Dim result, s, e, time, i As Long
Dim attached1 As String
Dim outlookObj As Outlook.Application
Dim mailItemObj As Outlook.mailItem
Dim myattachments As Outlook.Attachments
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Sub 連続送信マクロ()
result = MsgBox("連続送信を実行しますか？", vbYesNo + vbExclamation)
If result = vbYes Then
Set wslist = ThisWorkbook.Worksheets(1)
attached1 = wslist.Range("I4").Value
s = wslist.Range("B3").Value
e = wslist.Range("C3").Value
time = 2000
For i = s To e
wslist.Range("A3").Value = i
Set outlookObj = New Outlook.Application
Set mailItemObj = outlookObj.CreateItem(olMailItem)
Set myattachments = mailItemObj.Attachments
With mailItemObj
.To = wslist.Range("F1").Value
.CC = wslist.Range("F2").Value
.Subject = wslist.Range("F3").Value
.BodyFormat = olFormatHTML
.Body = wslist.Range("F4").Value & vbCrLf & _
wslist.Range("F5").Value & vbCrLf & _
wslist.Range("F6").Value & vbCrLf & _
wslist.Range("F7").Value & vbCrLf & _
wslist.Range("F8").Value
If attached1 = "" Then
GoTo Label1
End If
myattachments.Add attached1
Label1:
.Display
'.Send
End With
Sleep time
Next i
Set outlookObj = Nothing
MsgBox "送信完了"
Else
Exit Sub
End If
End Sub
