I got an automated emailing job setup in the SQL Server Agent that used to work in our previous SQL server at office. Now, it doesn't work on our new server. I've been thinking it's the new firewall settings preventing it to run successfuly. Can you guys tell me what components need to be setup or installed in the SQL server to make this work again? Here's the ActiveX script I setup in the SQL Server Agent job:
Does it need SQL Mail setup or Outlook installed in the server? I don't see any relation as I use CDONTS object in it.
Code:
Dim lObjConn
Dim lObjRs
Dim lStrSQL
Dim lObjMailer
Dim dewdate
Dim filesys, getname, fpath
Dim mapsw, getdir, newdrive
Dim WshNetwork
Dim usrname,passwd
Set lObjConn = CreateObject("ADODB.Connection")
lObjConn.Mode = 3
lObjConn.Open _
"Provider=SQLOLEDB.1;Data Source=myservername;" & _
"Initial Catalog=mydatabase;User ID=myuserid;Password=mypassword;"
Set lObjRs = CreateObject("ADODB.Recordset")
lObjRs.cursortype = 1
lObjRs.cursorlocation = 2
lObjRs.locktype = 3
lStrSQL = "SELECT [From], [To], [Subject], [Body], [Importance], " & _
"[BodyFormat], [MailFormat], [DueDate], [Attachment], [Recurrence] " & _
"FROM [Email]"
lObjRs.Open lStrSQL, lObjConn
While Not lObjRs.EOF
If IsNull(lObjRs(7)) then
dewdate = Now()
else
dewdate = lObjRs(7)
end if
if dewdate<=Now() then
Set lObjMailer = CreateObject("CDONTS.NewMail")
lObjMailer.From = lObjRs(0) & ""
lObjMailer.To = lObjRs(1) & ""
lObjMailer.Subject = lObjRs(2) & ""
lObjMailer.Body = lObjRs(3) & ""
mapsw = false
If not IsNull(lObjRs(8)) and Trim(lObjRs(8))<>"" then
Set filesys = CreateObject ("Scripting.FileSystemObject")
fpath = filesys.GetAbsolutePathName(Trim(lObjRs(8)))
If left(Trim(lObjRs(8)),2)="\\" then
Set WshNetwork = CreateObject("wscript.network")
newdrive = "y:"
On Error Resume Next
WshNetwork.removenetworkdrive newdrive
If Err <> 0 Then
Err.Clear
End if
On Error GoTo 0
getname = filesys.GetFileName(fpath)
getdir = left(fpath,instr(fpath,getname)-2)
mapsw = true
usrname = "mylocaldomain\administrator"
passwd = "myadminpassword"
WshNetwork.mapnetworkdrive newdrive, getdir, , usrname, passwd
fpath = getdir & "\" & getname
end if
If filesys.FileExists(fpath) Then
lObjMailer.AttachFile(fpath)
End If
end if
If IsNull(lObjRs(4)) then
lObjMailer.Importance = 1
else
lObjMailer.Importance = lObjRs(4)
end if
If IsNull(lObjRs(5)) then
lObjMailer.BodyFormat = 1
else
lObjMailer.BodyFormat = lObjRs(5)
end if
If IsNull(lObjRs(6)) then
lObjMailer.MailFormat = 1
else
lObjMailer.MailFormat = lObjRs(6)
end if
lObjMailer.Send
If not IsNull(lObjRs(8)) and Trim(lObjRs(8))<>"" then
Set filesys = nothing
if mapsw then
On Error Resume Next
WshNetwork.removenetworkdrive newdrive
If Err <> 0 Then
Err.Clear
End if
On Error GoTo 0
Set WshNetwork = Nothing
end if
end if
If not IsNull(lObjRs(9)) and lObjRs(9)>0 then
lObjRs(7) = dewdate + lObjRs(9)
lObjRs.Update
else
lObjRs.Delete
end if
Set lObjMailer = Nothing
end if
lObjRs.MoveNext
Wend
lObjRs.Close
lObjConn.Close
Set lObjRs = Nothing
Set lObjConn = Nothing