Vbscript to send mail:

I have this small vbscript to send mails through Outlook. Works fine.

Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(MailItem)
myItem.Display
myItem.SentOnBehalfOfName = "Anders Andersen"
myItem.To = "richard@company.com"
myItem.Send

Now I would like to modify it so that SentOnBehalfOfName and To
comes from an sql table.

The sql table has three fields 'From', 'To' and 'MailSent'.

The vbscript should loop through all records with MailSent=N.
When an e-mail has been successfully sent MailSent should be Set to Y.
nr VAsked:
Who is Participating?
 
Nitin SontakkeConnect With a Mentor DeveloperCommented:
Just one small thing. You don't need yet another recordset object (rs2) to fire the update query. Being an action query, it doesn't return a record set anyway. You can achieve the same result with following...

conn.Execute "Update...." 'the query as usual...
0
 
Richie_SimonettiIT OperationsCommented:
As you have used CreateObject to create an outlook object, you could do the same thing for and ADODB.Connection and an ADODB.Recordset...

dim conn
dim rs

set conn =createobject("ADODB.Connection")
with conn
     .connectionstring="Your_choice"
     .open
     set rs=createObject("ADODB.Recordset")
     rs.open "SQL statement here",conn
     do while not rs.eof
        ' your already code here
     loop
end with
0
 
Richie_SimonettiIT OperationsCommented:
dim conn
dim rs

set conn =createobject("ADODB.Connection")
with conn
    .connectionstring="Your_choice"
    .open
    set rs=createObject("ADODB.Recordset")
    rs.open "SQL statement here",conn
    do while not rs.eof
       ' your already code here
       if rs.fields("mailsent")="N" then
          'your already code here
          rs.fields("mailsent")="Y"
       end if
       rs.movenext
    loop
end with


0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
rpaiCommented:
How about having a SQL statement to select records that have MailSent = "N", so that you can get rid of the IF statement? (Richie's code posted above)

strSQL = "SELECT c_From, c_To, c_MailSent FROM c_Tbl WHERE c_MailSent = 'N'"
0
 
nr VAuthor Commented:
One problem.

Error: Current Recordset does not support updating. This may be a limitation of the provider ...

Here's my code.

dim conn
dim rs

set conn =createobject("ADODB.Connection")
with conn
   .connectionstring="driver={SQL Server};server=t23ola;uid=sa;pwd=;database=dev"
   .open
   set rs=createObject("ADODB.Recordset")
   rs.open "SELECT MailFrom, MailTo, MailSent FROM tbMessages",conn
   do while not rs.eof
   
   if rs.fields("MailSent")="N" Then
           
   Set myOlApp = CreateObject("Outlook.Application")
   Set myItem = myOlApp.CreateItem(MailItem)
   myItem.Display
   myItem.SentOnBehalfOfName = rs.fields("MailFrom")
   myItem.To = rs.fields("MailTo")
   myItem.Send
         
   rs.fields("MailSent")="Y"
   end if
   rs.movenext
   loop
end with
0
 
nr VAuthor Commented:
rpai, good idea. Works fine.

Any ideas about the updating problem?
0
 
rpaiCommented:
Unfortunately, not all types of cursors are recognized by all providers, but try this:-

Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.CursorType = adOpenDynamic
rs.open...


0
 
nr VAuthor Commented:
Another error.

Arguments are of the wrong type, are out of ...

Current code:

dim conn
dim rs

set conn = createobject("ADODB.Connection")
with conn
   .connectionstring="driver={SQL Server};server=t23ola;uid=sa;pwd=;database=dev"
   .open
   Set rs = CreateObject("ADODB.Recordset")
   rs.CursorLocation = adUseClient
   rs.CursorType = adOpenDynamic
   rs.open "SELECT MailFrom, MailTo, MailSent FROM tbMessages WHERE MailSent = 0",conn
   do while not rs.eof
       
   Set myOlApp = CreateObject("Outlook.Application")
   Set myItem = myOlApp.CreateItem(MailItem)
   myItem.Display
   myItem.SentOnBehalfOfName = rs.fields("MailFrom")
   myItem.To = rs.fields("MailTo")
   myItem.Send
         
   rs.fields("MailSent")=1

   rs.movenext
   loop
end With
0
 
rpaiCommented:
Include this in the beginning of your code.

Const adUseClient = 3
Const adLockOptimistic = 2

Else change the lines of code to (in this case do not include the above 2 lines):-
rs.CursorLocation = 3
rs.CursorType = 2
rs.open...
0
 
rpaiCommented:
The reason that you get the 'Arguments are of Wrong Type..' error is because, the ADO constants are not defined. You can work around this problem by setting constants as mentioned in my post above.

0
 
nr VAuthor Commented:
Now I'm back to Error: Current Recordset does not support updating.

Current code:

dim conn
dim rs

set conn = createobject("ADODB.Connection")
with conn
   .connectionstring="driver={SQL Server};server=t23ola;uid=sa;pwd=;database=dev"
   .open
   Set rs = CreateObject("ADODB.Recordset")
   rs.CursorLocation = 3
   rs.CursorType = 2
   rs.open "SELECT MailFrom, MailTo, MailSent FROM tbMessages WHERE MailSent = 0",conn
   do while not rs.eof
       
   Set myOlApp = CreateObject("Outlook.Application")
   Set myItem = myOlApp.CreateItem(MailItem)
   myItem.Display
   myItem.SentOnBehalfOfName = rs.fields("MailFrom")
   myItem.To = rs.fields("MailTo")
   myItem.Send
         
   rs.fields("MailSent")=1

   rs.movenext
   loop
end With
0
 
rpaiCommented:
Hmm..
Also, include the locktype
rs.CursorLocation = 3
rs.CursorType = 2
rs.locktype = 3 '--adLockOptimistic. The default value is adLockReadOnly.
rs.open...
0
 
Nitin SontakkeDeveloperCommented:
The best approach, i think would be to use action query. Create read-write recordsets could be resource intesive and a bit slower than creating action queries.

Does your table not have an id column? Or is it that all the records with 'N' (or 0) should receive the mail. In any case you can do as follows:

01. Get read-only recordset with "SELECT MailFrom, MailTo, MailSent FROM tbMessages WHERE MailSent = 0"
02. Send mail in do while...loop
03. Fire an action query "UPDATE tbMessages SET MailSent = 1 WHERE MailSent = 0" out side the loop.

0
 
nr VAuthor Commented:
rpai, now the update works.
0
 
nr VAuthor Commented:
rpai, now the update works.
0
 
nr VAuthor Commented:
NitinSontakke, I've changed to an action query. No problem.

One thing yet to be solved.

The field MailSent must only be set to 1
if the mail is sent successfully.

Somehow I think that I have to put the action query inside the loop and fire it for each record with "WHERE MessageID = ..."

I have added an id field 'MessageID'.

0
 
rpaiCommented:
I am glad that the update worked by changing the LockType.

Yes, whatever be the mechanism you are using to update the MailSent field (either an action query or an update recordset method), I would prefer to have the update statement within the loop rather than outside the loop.

0
 
nr VAuthor Commented:
I would need some help with one more line. (I'm new on vb.)

dim conn
dim rs

set conn = createobject("ADODB.Connection")

with conn

   .connectionstring="driver={SQL Server};server=t23ola;uid=sa;pwd=;database=dev"
   .open

   Set rs = CreateObject("ADODB.Recordset")

   rs.open "SELECT MessageID, MailFrom, MailTo, MailSent FROM tbMessages WHERE MailSent = 0",conn
   do while not rs.eof
   
   Set myOlApp = CreateObject("Outlook.Application")
   Set myItem = myOlApp.CreateItem(MailItem)
   myItem.SentOnBehalfOfName = rs.fields("MailFrom")
   myItem.To = rs.fields("MailTo")
   myItem.Send
   
   *****************************************************
   On success (mail sent) Update tbMessages Set MailSent = 1 WHERE MessageID = rs.fields("MessageID")
   *****************************************************
       
   rs.movenext
   loop
   
End With
0
 
rpaiCommented:
dim conn
dim rs

On Error Goto ErrHandler

set conn = createobject("ADODB.Connection")

with conn

  .connectionstring="driver={SQL Server};server=t23ola;uid=sa;pwd=;database=dev"
  .open

  Set rs = CreateObject("ADODB.Recordset")

  rs.open "SELECT MessageID, MailFrom, MailTo, MailSent FROM tbMessages WHERE MailSent = 0",conn
  do while not rs.eof
 
  Set myOlApp = CreateObject("Outlook.Application")
  Set myItem = myOlApp.CreateItem(MailItem)
  myItem.SentOnBehalfOfName = rs.fields("MailFrom")
  myItem.To = rs.fields("MailTo")
  myItem.Send
 
   Update tbMessages Set MailSent = 1 WHERE MessageID = rs.fields("MessageID")

 
Exit Function

ErrHandler:


     

End With
0
 
rpaiCommented:
Ooops!
You could use an Error handler to trap the error message.
So in case of errors, the update statement is not executed.

dim conn
dim rs

On Error Goto Errhandler

set conn = createobject("ADODB.Connection")

with conn

  .connectionstring="driver={SQL Server};server=t23ola;uid=sa;pwd=;database=dev"
  .open

  Set rs = CreateObject("ADODB.Recordset")

  rs.open "SELECT MessageID, MailFrom, MailTo, MailSent FROM tbMessages WHERE MailSent = 0",conn
  do while not rs.eof
 
  Set myOlApp = CreateObject("Outlook.Application")
  Set myItem = myOlApp.CreateItem(MailItem)
  myItem.SentOnBehalfOfName = rs.fields("MailFrom")
  myItem.To = rs.fields("MailTo")
  myItem.Send
 
   Update tbMessages Set MailSent = 1 WHERE MessageID = rs.fields("MessageID")
       
  rs.movenext
  loop

Exit Function

ErrHandler:

wscript.echo "Error" '-- whatever the way you wish you to handle the errors
 
End With
0
 
nr VAuthor Commented:
It's complaining about this line.

Update tbMessages Set MailSent = 1 WHERE MessageID = rs.fields("MessageID")

Expected end of statement.
0
 
Nitin SontakkeDeveloperCommented:
Unfortunately, you cannot fire queries like these. You will first need to build it and then fire, as shown below.

strQuery = "Update tbMessages Set MailSent = 1 WHERE MessageID = " & rs.fields("MessageID")

Please pay an extra attention to spaces...
0
 
nr VAuthor Commented:
I had just managed to get this code working satisfying.
Please comment.

dim conn
dim rs
dim rs2

On Error Resume Next

set conn = createobject("ADODB.Connection")

with conn

.connectionstring="driver={SQL Server};server=t23ola;uid=sa;pwd=;database=dev"
.open

Set rs = CreateObject("ADODB.Recordset")

rs.open "SELECT MessageID, MailFrom, MailTo, MailSent FROM tbMessages WHERE MailSent = 0",conn

Do while not rs.eof
 
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(MailItem)
myItem.SentOnBehalfOfName = rs.fields("MailFrom")
myItem.To = rs.fields("MailTo")
myItem.Send

If myItem.Sent = True Then
Set rs2 = CreateObject("ADODB.Recordset")
rs2.open "UPDATE tbMessages SET MailSent = 1 WHERE MessageID = " & rs.fields("MessageID"),conn
End If
       
rs.movenext
loop

End With
0
 
nr VAuthor Commented:
Richie, rpai and NitinSontakke@devx
I appreciate your help very much.

I just can't give points to all of you.
(There's no split feature, is there?)

I have posted two more questions related to the same script. Just in case you have time.

http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=visualbasic&qid=20314972

http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=msoutlook&qid=20315039
0
 
Richie_SimonettiIT OperationsCommented:
Not from me. Sorry.
0
 
Nitin SontakkeDeveloperCommented:
nr V,

There is a way to split the point, i think. You will need to ask for help from the moderator.

To be really fair, you should have asked the question before accepting my answer, at the least. Anyway.

If you do change your mind, i personally don't mind taking back points given to me already.

Although i love to see more points in my name, i am not here exclusively for that. I just enjoy helping other. Points are incidental.

0
 
nr VAuthor Commented:
I have asked a moderater to change to a 100 points each.

http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=commspt&qid=20315121

I didn't know you could do that. I'm sorry.
0
 
Computer101Commented:
As requested, I have made questions for the experts in the topic area.

Computer101
E-E Moderator
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.