Outlook Email Problems with Multiple Sends

[km2x]

Good Afternoon!

I am having problems running this code more than once. It will send an email the first time, but then hangs on concurrent tries. Any help would be greatly appreciated!

K

Private Sub Command84_Click()
Dim mySql As String, rs As New ADODB.Recordset, rs1 As New ADODB.Recordset
Dim mySql1 As String, mySql2 As String, mySql3 As String
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim info As Variant
Dim ApprovalName As String
Dim login As String
Dim Linker As String
Dim Response As String
Dim varEmail As Variant
Dim varEmail1 As Variant
Dim intRecordCount As Integer
Dim counter As Integer
Dim username As String
Dim counter2




mySql1 = "SELECT Email FROM Users"

rs.Open mySql1, cn, adOpenStatic, adLockBatchOptimistic

counter = 0
varEmail = ""
  
  Do Until rs.EOF
  
   varEmail1 = rs(0)
   If varEmail1 <> &quot;&quot; Then
    varEmail = varEmail1 & &quot;;&quot; & varEmail
    Else: End If
    rs.MoveNext
    counter = counter + 1
Loop

login = NetUserID()
mySql2 = &quot;SELECT FullName FROM USERS Where UserName = &quot; & Chr(34) & login & Chr(34) & &quot;&quot;

rs1.Open mySql2, cn, adOpenStatic, adLockBatchOptimistic
ApprovalName = rs1(0)
info = &quot;A Approval Request has been submitted by &quot; & ApprovalName & &quot; Regarding Epic Procedure Number &quot; & Me.TMID & &quot; &&quot; _
        & &quot;Please review within in the Procedure Tracking database.&quot; & Chr(13) & &quot;MEMO: &quot; & Me.MemoField1 & &quot;&quot;


Response = MsgBox(&quot;Do you want to Finalize the Approval Record?&quot; & Chr(13) & Chr(13) & &quot;This will send notification emails!&quot;, vbOKCancel)
If Response = vbOK Then
        Linker = Me.ApprovalMasterNum
        mySql = &quot;Update Approval_Table Set InReviewFlag = True WHERE ApprovalMasterNum =&quot; & Linker & &quot;&quot;
        cn.Execute mySql
        DoCmd.SendObject , , , varEmail, , , &quot;Approval Request&quot;, info, False
        
        Else: Exit Sub
End If
cn.Close

DoCmd.Close