The problem seems to relate to the apparently unnecessary loops, the purpose of which is not explained by your code.
Are you planning on running this code from Excel or as implied from your post from Outlook. If the latter you can simplify the code
Sub ScreenAndSend()
Dim olMailOutput As Outlook.MailItem
Set olMailOutput = CreateItem(olMailItem)
With olMailOutput
.To = "<list of e-mail addresses"
.BCC = "<list of e-mail addresses"
.Subject = "my subject"
.BodyFormat = olFormatHTML
.Body = "content of the mail"
.Display 'change to .Send after testing
Debug.Print "mail send"
End With
Set olMailOutput = Nothing
End Sub
If the former, it gets a whole lot more complicated. The following is a typical example
Public Sub CreateEmail()
'Graham Mayor - https://www.gmayor.com - Last updated - 18 May 2021
'Requires the code - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.
Dim olApp As Object
Dim olMail As Object ' Outlook.MailItem
Dim olInsp As Object ' Outlook.Inspector
Dim wdDoc As Object ' Word.Document
Dim wdRange As Object ' Word.Range
Set olApp = OutlookApp()
Set olMail = olApp.CreateItem(0)
With olMail
.BodyFormat = 2
.Display
.To = "someone@somewhere.com"
.Subject = "Message Subject"
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set wdRange = wdDoc.Range
With wdRange
.Collapse 1
.Font.Color = RGB(0, 0, 0)
.Font.Size = 11
.Font.Bold = False
.Text = "Hi, " & "Name of person" & vbCr & vbCr & _
"Here is your invoice # " & "123456"
.Collapse 0
.Text = " PAID "
.Font.Color = RGB(255, 0, 0)
.Font.Size = 16
.Font.Bold = True
.Collapse 0
.Text = "more text and end of email" 'signature associated with account is retained.
.Font.Color = RGB(0, 0, 0)
.Font.Size = 11
.Font.Bold = False
End With
End With
lbl_Exit:
Set wdRange = Nothing
Set wdDoc = Nothing
Set olInsp = Nothing
Set olMail = Nothing
Set olApp = Nothing
Exit Sub
End Sub