On Error Resume Next
Dim strConn,Conn,RecObj,strSQL,strSubject,strStatus,strBody,objMail,strDate
Dim intCount,blnBCC,strTeamA,strTeamB : intCount = 0
Const Appending=8
strConn = "Provider=SQLOLEDB;Data Source=WIN-59JDF64IOMC;Initial Catalog=cloudspo_sportsmgr;User Id=cloudspo_sports;password=letmein@cliff64"
'***EMAIL CONSTANT
Const cdoContentDisposition = "urn:schemas:mailheader:content-disposition"
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSendUsingPort = 2
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cdoBasic = 1
Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const EMAIL_FORM = "donotreply@sportsmgr.us"
Set Conn = CreateObject("adodb.Connection")
With Conn
.ConnectionString = strConn
.Open
End With
strSQL = "EXECUTE dbo.USP_REMINDER_COPY 8"
Set RecObj = CreateObject("adodb.recordset")
With RecObj
.Open strSQL,Conn
If .EOF = False Then
blnBCC = .Fields(0)
Else
blnBCC = "F"
End If
.Close()
End With
Set RecObj = Nothing
strSQL = "EXECUTE dbo.USP_SAVE_EMAIL_LOGS 2,0,0"
Set RecObj = CreateObject("adodb.recordset")
With RecObj
.Open strSQL,Conn
If .EOF = False Then
intLog = .Fields(0)
End If
.Close()
End With
Set RecObj = Nothing
strSQL = "EXECUTE dbo.USP_SCORE_LINK"
Set dicGames=CreateObject("Scripting.Dictionary")
Set dicGameID=CreateObject("Scripting.Dictionary")
Set RecObj = CreateObject("adodb.recordset")
With RecObj
.Open strSQL,Conn
Do While .EOF = False
If IsNull(.Fields("DivA")) Or IsNull(.Fields("DivB")) Then
strGameInfo = " - " & .Fields("Season") & "-" & .Fields("League") & " - " & .Fields("TeamAName") & " vs. " & .Fields("TeamBName") & " " & .Fields("Date")
strTeamAName = .Fields("TeamAName")
strTeamBName = .Fields("TeamBName")
Else
strGameInfo = " - " & .Fields("Season") & "-" & .Fields("League") & " - " & .Fields("DivA") & "-" & .Fields("TeamAName") & " vs. " & .Fields("DivB") & "-" & .Fields("TeamBName") & " " & .Fields("Date")
strTeamAName = .Fields("DivA") & "-" & .Fields("TeamAName")
strTeamBName = .Fields("DivB") & "-" & .Fields("TeamBName")
End If
If Trim(.Fields("Email")) <> "" And Trim(.Fields("Email2")) <> "" Then
strTo = Trim(.Fields("Email"))
strCC = Trim(.Fields("Email2"))
strEmailTo = strTo
ElseIf Trim(.Fields("Email")) <> "" Then
strTo = Trim(.Fields("Email"))
strCC = ""
strEmailTo = strTo
ElseIf Trim(.Fields("Email2")) <> "" Then
strTo = Trim(.Fields("Email2"))
strCC = ""
strEmailTo = strTo
End If
strName = .Fields("FirstName")
strTMLink = "" & strScore2 & " This Game"
strBody = "
" & _
" " & _
"
"
If .Fields("Scorable") = "Y" Then
strScore = "Scoring"
Else
strScore = "Confirming"
End If
strSubject = .Fields("OrgName") & " " & strScore & " Request" & strGameInfo & " " & .Fields("GameID")
'***SEND EMAIL
Call Send_Email(strTo,strCC, strSubject,strBody)
'**SEND EMAIL
If dicGameID.Exists(strGameID) = False Then
dicGameID.Add strGameID,strGameID
If strGames = "" Then
strGames = .Fields("GameID")
Else
strGames = strGames & "," & .Fields("GameID")
End If
End If
If .Fields("TeamOrder") = 0 Then
Conn.Execute "UPDATE Games SET EmailedTM1='" & .Fields("FamilyID") & "' WHERE (GameID=" & .Fields("GameID") & ")"
Else
Conn.Execute "UPDATE Games SET EmailedTM2='" & .Fields("FamilyID") & "' WHERE (GameID=" & .Fields("GameID") & ")"
End If
.MoveNext
Loop
End With
RecObj.Close() : Set RecObj = Nothing
strSQL = "EXECUTE dbo.USP_SAVE_EMAIL_LOGS 3," & intCount & "," & intLog & ",'" & strGames & "'"
Conn.Execute(strSQL)
Sub Send_Email(ByVal strTo,ByVal strCC, ByVal strSubject, ByVal strBody)
Dim objMail
If strTo = "" Then
Exit Sub
End If
Set objConfig = CreateObject("CDO.Configuration")
Set Fields = objConfig.Fields
With Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "mail.sportsmgr.us"
.Item(cdoSMTPServerPort) = 25
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = "donotreply@sportsmgr.us"
.Item(cdoSendPassword) = "Shadow@1958"
.Item(cdoSMTPConnectionTimeout) = 10
.Update
End With
Set objMail = CreateObject("CDO.Message")
Set objMail.Configuration = objConfig
objMail.Subject = strSubject
objMail.From = "donotreply@sportsmanager.us"
objMail.To = strTo
'objMail.BCC = "copy"
If strCC <> "" Then
objMail.Cc = strCC
End If
objMail.HTMLBody = strBody
objMail.Send
Set objMail=Nothing
Set objConfig = Nothing
End Sub
Conn.Close() : Set Conn = Nothing