Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Emailing Problem

[b][red]This message was edited by NeoFlex at 2005-10-12 12:10:22[/red][/b][hr]
I know its alot to look at, but this whole thing is set up to grab information out of our database and put it in an email that is then sent to our shipping providers. The only problem is that our shipping providers are saying that we are sending over the same order split up into a lot of different emails...
I'v spent the past 5 hours looking at this stupid thing and I cant find why its doing it. Anybody that can give any help or maybe a better idea of how to do this... Thanks in advince.





Private Sub CmdSend_Click()
Dim ADOCon As New ADODB.Connection
Dim strSQL As String

cUser = UCase(Left(CurrentUser, 1)) & LCase(Right(CurrentUser, Len(CurrentUser) - 1))
If cUser = "Administrator" Then cUser = "Patrick"
sentcnt = 0

Set Mail = CreateObject("Persits.MailSender")

Set ADOCon = CurrentProject.Connection
strSQL = "SELECT [Customer Info].ORDERID, [Customer Info].SHIPNOTES, [Customer Info].SHIPCOMP, [Customer Info].SHIPNAME, [Customer Info].SHIPADDR1, [Customer Info].SHIPADDR2, [Customer Info].SHIPCITY, [Customer Info].SHIPSTATE, [Customer Info].SHIPZIP, [Customer Info].RESIDENCE, [Customer Info].PONUM, [Customer Info].SHIPVIA, [Order Details].STYLE, [Order Details].DESCRIPTION, [Order Details].QTY FROM [Customer Info] INNER JOIN [Order Details] ON [Customer Info].ORDERID = [Order Details].ORDERID WHERE ((InStr([STYLE], '-P') > 0) And (([Customer Info].PCheck) <> 0) And (([Customer Info].CANCELLED) = 0)) ORDER BY [Order Details].STYLE;"
Set rs = ADOCon.Execute(strSQL)
Do While Not rs.EOF
'Mail.UserName = "BLANKED OUT"
'Mail.Password = "BLANKED OUT"
Mail.Host = "mail.sbcglobal.net"
Mail.IsHTML = True
Mail.Reset
Me.Text6.Caption = "Sending " & rs("ORDERID")
Me.Text9.Visible = True
msgBody = "

BLANK SHIRTS, INC.Acct: 63042Purchase Order: " & rs("ORDERID") & "Vendor: The Wild SidePurchasing Agent: " & cUser & "Order Date: " & Now() & "

Drop Ship To:"
msgBody = msgBody & UCase(rs("SHIPCOMP")) & ""
msgBody = msgBody & UCase(rs("SHIPNAME")) & ""
msgBody = msgBody & UCase(rs("SHIPADDR1")) & ""
If IsNull(rs("SHIPADDR2")) = False And rs("SHIPADDR2") <> " " Then msgBody = msgBody & UCase(rs("SHIPADDR2")) & ""
If rs("RESIDENCE") = 0 Then strRes = " - (Commercial)" Else strRes = " - (Residential)"
msgBody = msgBody & UCase(rs("SHIPCITY")) & ", " & UCase(rs("SHIPSTATE")) & " " & UCase(rs("SHIPZIP")) & "

Ship Via: " & rs("SHIPVIA") & strRes & "

"
msgBody = msgBody & "***All Quantities are in Dozens***"
msgBody = msgBody & ""
ordB4 = rs("ORDERID")
totQty = 0
Do While Not rs.EOF
If ordB4 <> rs("ORDERID") Then Exit Do
msgBody = msgBody & "" & vbCrLf
totQty = totQty + rs("QTY")
flg = 1
ordB4 = rs("ORDERID")
rs.MoveNext
Loop
msgBody = msgBody & "
StyleDescriptionQuantity
" & rs("STYLE") & "" & rs("DESCRIPTION") & "" & rs("QTY") & "

Total Order Quantity: " & totQty & "

Ship All Orders Blind!Confirm All Orders by Phone before releasing with Liz at (775) 885-1867 ext.202


"
'Send Mail
Mail.Body = msgBody

Mail.FROM = "BLANKED OUT"
Mail.FromName = "Blank Shirts, Inc."
Mail.AddAddress "BLANKED OUT"
Mail.AddAddress "BLANKED OUT"
Mail.AddAddress "BLANKED OUT"
Mail.AddAddress "BLANKED OUT"
Mail.Subject = "Purchase Order " & ordB4

On Error Resume Next
Mail.Send
If Err <> 0 Then
'''Try Second Server
Err.Clear
strError = Module1.EmailRelay("Blank Shirts, Inc.", "purchasing@transfersupply.com", "pat@blankshirts.com; purchase@t-shirtwholesaler.com", "Purchase Order " & ordB4 & " (BS)(" & strLoc & ")", msgBody)
If Err <> 0 Or strError = "Fail" Then
MsgBox "Order " & ordB4 & " Failed to send. An error occurred: " & Err.DESCRIPTION
Else
DoCmd.RunSQL "INSERT INTO [Emailed Orders] ( ORDERID, EMAILTIME ) SELECT '" & ordB4 & "' AS Expr2, Now() AS Expr1;"
DoCmd.RunSQL "UPDATE [Customer Info] SET [Customer Info].PCheck = 0, [Customer Info].PDATE = Date() WHERE ((([Customer Info].ORDERID)='" & ordB4 & "'));"
sentcnt = sentcnt + 1
Me.Requery
End If
Else
DoCmd.RunSQL "INSERT INTO [Emailed Orders] ( ORDERID, EMAILTIME ) SELECT '" & ordB4 & "' AS Expr2, Now() AS Expr1;"
DoCmd.RunSQL "UPDATE [Customer Info] SET [Customer Info].PCheck = 0, [Customer Info].PDATE = Date() WHERE ((([Customer Info].ORDERID)='" & ordB4 & "'));"
sentcnt = sentcnt + 1
Me.Requery
End If

If rs.EOF Then Exit Do
Loop

Me.Text6.Caption = " "
Me.Text9.Visible = False

rs.Close
Set rs = Nothing
ADOCon.Close
Set ADOCon = Nothing

If sentcnt > 0 Then MsgBox "Successfully emailed " & sentcnt & " orders"
End Sub


Comments

  • aatkbdaatkbd Member Posts: 42
    [blue]
    you need to put rs.movenext at the end of your while loop.
    [/blue]

    : [b][red]This message was edited by NeoFlex at 2005-10-12 12:10:22[/red][/b][hr]
    : I know its alot to look at, but this whole thing is set up to grab information out of our database and put it in an email that is then sent to our shipping providers. The only problem is that our shipping providers are saying that we are sending over the same order split up into a lot of different emails...
    : I'v spent the past 5 hours looking at this stupid thing and I cant find why its doing it. Anybody that can give any help or maybe a better idea of how to do this... Thanks in advince.
    :
    :
    :
    :
    :
    : Private Sub CmdSend_Click()
    : Dim ADOCon As New ADODB.Connection
    : Dim strSQL As String
    :
    : cUser = UCase(Left(CurrentUser, 1)) & LCase(Right(CurrentUser, Len(CurrentUser) - 1))
    : If cUser = "Administrator" Then cUser = "Patrick"
    : sentcnt = 0
    :
    : Set Mail = CreateObject("Persits.MailSender")
    :
    : Set ADOCon = CurrentProject.Connection
    : strSQL = "SELECT [Customer Info].ORDERID, [Customer Info].SHIPNOTES, [Customer Info].SHIPCOMP, [Customer Info].SHIPNAME, [Customer Info].SHIPADDR1, [Customer Info].SHIPADDR2, [Customer Info].SHIPCITY, [Customer Info].SHIPSTATE, [Customer Info].SHIPZIP, [Customer Info].RESIDENCE, [Customer Info].PONUM, [Customer Info].SHIPVIA, [Order Details].STYLE, [Order Details].DESCRIPTION, [Order Details].QTY FROM [Customer Info] INNER JOIN [Order Details] ON [Customer Info].ORDERID = [Order Details].ORDERID WHERE ((InStr([STYLE], '-P') > 0) And (([Customer Info].PCheck) <> 0) And (([Customer Info].CANCELLED) = 0)) ORDER BY [Order Details].STYLE;"
    : Set rs = ADOCon.Execute(strSQL)
    : Do While Not rs.EOF
    : 'Mail.UserName = "BLANKED OUT"
    : 'Mail.Password = "BLANKED OUT"
    : Mail.Host = "mail.sbcglobal.net"
    : Mail.IsHTML = True
    : Mail.Reset
    : Me.Text6.Caption = "Sending " & rs("ORDERID")
    : Me.Text9.Visible = True
    : msgBody = "

    BLANK SHIRTS, INC.Acct: 63042Purchase Order: " & rs("ORDERID") & "Vendor: The Wild SidePurchasing Agent: " & cUser & "Order Date: " & Now() & "

    Drop Ship To:"
    : msgBody = msgBody & UCase(rs("SHIPCOMP")) & ""
    : msgBody = msgBody & UCase(rs("SHIPNAME")) & ""
    : msgBody = msgBody & UCase(rs("SHIPADDR1")) & ""
    : If IsNull(rs("SHIPADDR2")) = False And rs("SHIPADDR2") <> " " Then msgBody = msgBody & UCase(rs("SHIPADDR2")) & ""
    : If rs("RESIDENCE") = 0 Then strRes = " - (Commercial)" Else strRes = " - (Residential)"
    : msgBody = msgBody & UCase(rs("SHIPCITY")) & ", " & UCase(rs("SHIPSTATE")) & " " & UCase(rs("SHIPZIP")) & "

    Ship Via: " & rs("SHIPVIA") & strRes & "

    "
    : msgBody = msgBody & "***All Quantities are in Dozens***"
    : msgBody = msgBody & ""
    : ordB4 = rs("ORDERID")
    : totQty = 0
    : Do While Not rs.EOF
    : If ordB4 <> rs("ORDERID") Then Exit Do
    : msgBody = msgBody & "" & vbCrLf
    : totQty = totQty + rs("QTY")
    : flg = 1
    : ordB4 = rs("ORDERID")
    : rs.MoveNext
    : Loop
    : msgBody = msgBody & "
    StyleDescriptionQuantity
    " & rs("STYLE") & "" & rs("DESCRIPTION") & "" & rs("QTY") & "

    Total Order Quantity: " & totQty & "

    Ship All Orders Blind!Confirm All Orders by Phone before releasing with Liz at (775) 885-1867 ext.202


    "
    : 'Send Mail
    : Mail.Body = msgBody
    :
    : Mail.FROM = "BLANKED OUT"
    : Mail.FromName = "Blank Shirts, Inc."
    : Mail.AddAddress "BLANKED OUT"
    : Mail.AddAddress "BLANKED OUT"
    : Mail.AddAddress "BLANKED OUT"
    : Mail.AddAddress "BLANKED OUT"
    : Mail.Subject = "Purchase Order " & ordB4
    :
    : On Error Resume Next
    : Mail.Send
    : If Err <> 0 Then
    : '''Try Second Server
    : Err.Clear
    : strError = Module1.EmailRelay("Blank Shirts, Inc.", "purchasing@transfersupply.com", "pat@blankshirts.com; purchase@t-shirtwholesaler.com", "Purchase Order " & ordB4 & " (BS)(" & strLoc & ")", msgBody)
    : If Err <> 0 Or strError = "Fail" Then
    : MsgBox "Order " & ordB4 & " Failed to send. An error occurred: " & Err.DESCRIPTION
    : Else
    : DoCmd.RunSQL "INSERT INTO [Emailed Orders] ( ORDERID, EMAILTIME ) SELECT '" & ordB4 & "' AS Expr2, Now() AS Expr1;"
    : DoCmd.RunSQL "UPDATE [Customer Info] SET [Customer Info].PCheck = 0, [Customer Info].PDATE = Date() WHERE ((([Customer Info].ORDERID)='" & ordB4 & "'));"
    : sentcnt = sentcnt + 1
    : Me.Requery
    : End If
    : Else
    : DoCmd.RunSQL "INSERT INTO [Emailed Orders] ( ORDERID, EMAILTIME ) SELECT '" & ordB4 & "' AS Expr2, Now() AS Expr1;"
    : DoCmd.RunSQL "UPDATE [Customer Info] SET [Customer Info].PCheck = 0, [Customer Info].PDATE = Date() WHERE ((([Customer Info].ORDERID)='" & ordB4 & "'));"
    : sentcnt = sentcnt + 1
    : Me.Requery
    : End If
    :
    [b][red] rs.movenext [/red][/b]
    : [b][green]'If rs.EOF Then Exit Do[/b][/green] [red] comment this out[/red]
    : Loop
    :
    : Me.Text6.Caption = " "
    : Me.Text9.Visible = False
    :
    : rs.Close
    : Set rs = Nothing
    : ADOCon.Close
    : Set ADOCon = Nothing
    :
    : If sentcnt > 0 Then MsgBox "Successfully emailed " & sentcnt & " orders"
    : End Sub
    :
    :
    :

Sign In or Register to comment.