You'll need to add AxMAPISession and AxMAPIMessages to your form.
The emails are sent via Outlook.
If you don't want to use that, I'm sure that parts of the code will provide your loop.
Private Sub MySyb()
' Email reports to specified recipients
strSubject = "My Subject"
strBody = "My Body"
' Collect the email addresses for each recipient
strSQL = "SELECT Name AS Addressee FROM Recipient ORDER BY Name"
strSub = strSubName + " - Filling recipient dataset"
objDSRecipient = FillDataSet(strConn, strSQLRecipient)
' Send the emails
With objDSRecipient.Tables(0)
' Loop through the records and select reports for current recipient
If .Rows.Count > 0 Then
For X = 0 To .Rows.Count - 1
intRecipientID = CInt(.Rows(X).Item("ID").ToString)
ReDim strAddressArray(1)
strAddressArray(1) = .Rows(X).Item("Addressee").ToString
Next X ' Recipient
NewEmail(strAddressArray, _
strBody, strSubject)
End If
End With
Catch objA As Exception
Cursor.Current = Cursors.Default
MessageBox.Show("Error in sub '" & strSub & "' with " & objA.Source & _
vbCrLf & vbCrLf & objA.Message, "Error", _
MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
Cursor = Cursors.Default
objDSRecipient = Nothing
End Try
End Sub
Public Function FillDataSet(ByVal strConn As String, _
ByVal strProc As String) As Data.DataSet
Dim objDS As New Data.DataSet
Dim objDA As SqlClient.SqlDataAdapter
Try
strSubName = "FillDataSet"
strSub = strSubName + " - Initialising variables"
Cursor.Current = Cursors.WaitCursor 'vbHourglass
' Initialise the SqlDataAdapter with the stored procedure/SQL
' and connection string, and then use the SqlDataAdapter to fill
' the Dataset with data.
strSub = strSubName + " - Creating DataAdapter & Filling Dataset"
objDA = New SqlClient.SqlDataAdapter(strProc, strConn)
objDA.Fill(objDS)
FillDataSet = objDS
Catch objA As Exception
MessageBox.Show("Error in sub '" & strSub & "' with " & objA.Source & _
vbCrLf & vbCrLf & objA.Message, "Error", _
MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
Cursor.Current = Cursors.Default ' vbDefault
objDS = Nothing
objDA = Nothing
End Try
End Function
Private Sub NewEmail(ByVal strAddress() As String, _
ByVal strAttachment() As String, _
Optional ByVal strBody As String = "", _
Optional ByVal strSubject As String = "", _
Optional ByVal strAttachName As String = "")
Dim X As Integer
Dim lngFile As Long
Dim strRecord As String
Try
strSubName = Me.GetType.ToString + " - NewEmail"
strSub = strSubName + " - Preparing Email"
' Trigger default email client to send file
mapSession.SignOn()
With mapMessage
.SessionID = mapSession.SessionID
.MsgIndex = -1
.Compose()
strSub = strSubName + " - Adding Recipient(s)"
' Add address(s) of recipient(s)
For X = 1 To UBound(strAddress)
.RecipIndex = X - 1
' .RecipAddress = strAddress(X)
.RecipDisplayName = strAddress(X)
Next X
'Close()
' Add message subject
.MsgSubject = strSubject
strSub = strSubName + " - Dealing With Attachment(s)"
' Deal with attachment(s)
If blnAttachments Then
' Deal with message text - attachments
' Reserve space for attachments
strMsg = Space(UBound(strAttachment)) & vbCrLf
If Len(strBody) > 0 Then
.MsgNoteText = strMsg & strBody
Else
.MsgNoteText = strMsg & ""
End If
If Len(strAttachment(1)) > 0 Then
For X = UBound(strAttachment) To 1 Step -1
.AttachmentIndex = X - 1
.AttachmentPosition = X - 1
If Len(strAttachName) > 0 Then
.AttachmentName = strAttachName
End If
.AttachmentPathName = strAttachment(0) & "\" & strAttachment(X)
'MsgBox(.AttachmentPathName)
' .AttachmentName = strAttachName
Next X
End If
Else
strSub = strSubName + " - Dealing With Message Text"
' Deal with message text - no attachments
If Len(strBody) > 0 Then
.MsgNoteText = strBody
End If
End If
strSub = strSubName + " - Sending Email"
.Send(False) ' False means that there is user interaction; with True there is
End With
Catch objA As Exception
'MsgBox(Err.Number)
If Err.Number = 32001 Then ' User Cancelled
Exit Try
ElseIf Err.Number = 32026 Then ' Cancelled email from Outlook security message
MsgBox("Email message to " + strAddress(1) + " cancelled by user")
Security.WriteUserAudit(20, strUser, strAddress(1))
Exit Try
ElseIf Err.Number = 32011 Then ' Attachment not found
MsgBox("Attachment not found for email message to " + strAddress(1), MsgBoxStyle.Information, "Attachment Not Found")
Exit Try
End If
MessageBox.Show("Error in sub '" & strSub & "' with " & objA.Source & _
vbCrLf & vbCrLf & objA.Message, "Error", _
MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
strSub = strSubName + " - Close Session"
mapSession.SignOff()
End Try
End Sub
From MickT - 5th Sept 2008