Solved

Vbscript to send mail:

Posted on 2002-06-21
28
1,128 Views
Last Modified: 2011-10-03
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.
0
Comment
Question by:nr V
  • 12
  • 8
  • 4
  • +2
28 Comments
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7099927
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
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7099931
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
 
LVL 5

Expert Comment

by:rpai
ID: 7099968
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
 

Author Comment

by:nr V
ID: 7099969
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
 

Author Comment

by:nr V
ID: 7099971
rpai, good idea. Works fine.

Any ideas about the updating problem?
0
 
LVL 5

Expert Comment

by:rpai
ID: 7099975
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
 

Author Comment

by:nr V
ID: 7099981
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
 
LVL 5

Expert Comment

by:rpai
ID: 7099988
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
 
LVL 5

Expert Comment

by:rpai
ID: 7099989
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
 

Author Comment

by:nr V
ID: 7099994
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
 
LVL 5

Expert Comment

by:rpai
ID: 7100006
Hmm..
Also, include the locktype
rs.CursorLocation = 3
rs.CursorType = 2
rs.locktype = 3 '--adLockOptimistic. The default value is adLockReadOnly.
rs.open...
0
 
LVL 6

Expert Comment

by:Nitin Sontakke
ID: 7100267
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
 

Author Comment

by:nr V
ID: 7100356
rpai, now the update works.
0
 

Author Comment

by:nr V
ID: 7100368
rpai, now the update works.
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 

Author Comment

by:nr V
ID: 7100387
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
 
LVL 5

Expert Comment

by:rpai
ID: 7100911
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
 

Author Comment

by:nr V
ID: 7100929
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
 
LVL 5

Expert Comment

by:rpai
ID: 7100940
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
 
LVL 5

Expert Comment

by:rpai
ID: 7100942
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
 

Author Comment

by:nr V
ID: 7100948
It's complaining about this line.

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

Expected end of statement.
0
 
LVL 6

Expert Comment

by:Nitin Sontakke
ID: 7101016
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
 

Author Comment

by:nr V
ID: 7101030
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
 
LVL 6

Accepted Solution

by:
Nitin Sontakke earned 100 total points
ID: 7101037
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
 

Author Comment

by:nr V
ID: 7101068
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
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7101096
Not from me. Sorry.
0
 
LVL 6

Expert Comment

by:Nitin Sontakke
ID: 7101104
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
 

Author Comment

by:nr V
ID: 7101530
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
 
LVL 1

Expert Comment

by:Computer101
ID: 7101683
As requested, I have made questions for the experts in the topic area.

Computer101
E-E Moderator
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

25 Experts available now in Live!

Get 1:1 Help Now