Solved

VB Timer

Posted on 2004-10-18
29
900 Views
Last Modified: 2007-12-19
I created a VBScript that creates a user and mail enables it in exchange server. It works fine by simply double clicking on it. I also added a piece of code that sends a generic message to that mailbox. Unfortunately it takes a couple of seconds for the mailbox to be created and replicated. You can see the user and its SMTP address in Active Directory, but there won't be any messages in its mailbox. Is there a piece of code that can be placed above the line responsible for sending the message to put a delay on sending the message?

Thanks,
Bobby
byounessian@phippsny.org
0
Comment
Question by:Phipps-IT
  • 15
  • 13
29 Comments
 
LVL 42

Expert Comment

by:frodoman
ID: 12341952
Declare this API:

Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Use it this way - value is milliseconds:

Sleep(1000)
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12341973
If you're going to wait for more than a second or two you may want to use this approach instead - it'll allow Windows to continue processing other apps messages:

Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

Private Sub MyPause(Interval As Long)
Dim Start
Start = GetTickCount
Do While GetTickCount < Start + Interval
DoEvents
Loop
End Sub

'Pause for 5000 milliseconds
MyPause 5000
0
 
LVL 1

Expert Comment

by:alfanhendro
ID: 12344948
or maybe you can just put

DoEvents

0
 

Author Comment

by:Phipps-IT
ID: 12347745
Thank you for the code. The question is where to put it. Billow is the script. thanks for your help.


userName = InputBox(StrMsg,"Enter Username:")
tempPassword = "phipps"


splitName = Split(userName, " ")
firstName = lcase(splitName(0))
lastName = lcase(splitName(1))
logonName = left(firstName,1) & lastName
upnName = LogonName & UPNDomain

Set RootDSE = GetObject("LDAP://RootDSE")
domainDN = RootDSE.Get("DefaultNamingContext")
Set userContainer = GetObject("LDAP://cn=users," & _
   domainDN)

set newUser = userContainer.Create("user", "cn=" & _
   userName)
newUser.SamAccountName = logonName
newUser.SetInfo

newUser.FirstName = firstName
newUser.LastName = lastName
newuser.DisplayName = userName
newUser.Description = "Test User"
newUser.AccountDisabled = FALSE
newUser.SetPassword(tempPassword)
newUser.SetInfo

Dim oIADSUser
Dim oMailbox

Set oIADS = GetObject("LDAP://RootDSE")
strDefaultNC = oIADS.Get("defaultnamingcontext")
'MsgBox FindAnyMDB("CN=Configuration," & strDefaultNC)

'TODO: Use the newly created domain user account to replace the "Tom Cruse".
Set oIADSUser = (newUser)


If oIADSUser Is Nothing then
      MsgBox "The oIADSUser is Nothing."
Else
      MsgBox "The oIADSUser is created successfully."
End If

Set oMailBox = oIADSUser
oMailbox.CreateMailbox FindAnyMDB("CN=Configuration," & strDefaultNC)
oIADSUser.SetInfo

Function FindAnyMDB(strConfigurationNC)
      Dim oConnection
      Dim oCommand
      Dim oRecordSet
      Dim strQuery

      ' Open the Connection.
      Set oConnection = CreateObject("ADODB.Connection")
      set oCommand = CreateObject("ADODB.Command")
      Set oRecordSet = CreateObject("ADODB.Recordset")

      oConnection.Provider = "ADsDSOObject"
      oConnection.Open "ADs Provider"

      ' Build the query to find the private MDB.
      strQuery = "<LDAP://" & strConfigurationNC & ">;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

      oCommand.ActiveConnection = oConnection
      oCommand.CommandText = strQuery
      Set oRecordSet = oCommand.Execute

      ' If you have an MDB, return the first one.
      If Not oRecordSet.EOF Then
            oRecordSet.MoveFirst
            FindAnyMDB = CStr(oRecordSet.Fields("ADsPath").Value)
      Else
            FindAnyMDB = ""
      End If


      'Clean up.
      oRecordSet.Close
      oConnection.Close
      Set oRecordSet = Nothing
      Set oCommand = Nothing
      Set oConnection = Nothing




End Function

'Sending a text email  
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Welcome to Phipps Houses"
objMessage.Sender = "administrator@test.com"
objMessage.To = "Bbou@test.com"
objMessage.TextBody = "This is some sample message text."
objMessage.Send




0
 
LVL 42

Expert Comment

by:frodoman
ID: 12348029
Put it wherever you want the pause to be - I'm guessing you'd want it right below the "Sending a text email" comment line - just before you create the message.

frodoman
0
 

Author Comment

by:Phipps-IT
ID: 12348723
Yes I've tried that and kept getting Error: Expected end of statement Code: 800A0401

Anything else sould be added?
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12349444
You need to put the 'declare function' at the top in your form's general declarations section..

You need to put the function itself somewhere near the top of your code - out of the stream of execution.

The line we're discussing should have ONLY the call to the function.
0
 

Author Comment

by:Phipps-IT
ID: 12350283
Still getting the same error. ??
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12350462
Can you show your complete code as it looks now w/ the new delay included?
0
 

Author Comment

by:Phipps-IT
ID: 12350580
this function prevents the inputbox to popup.

Here it is:



Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

userName = InputBox(StrMsg,"Enter Username:")
tempPassword = "phipps"


splitName = Split(userName, " ")
firstName = lcase(splitName(0))
lastName = lcase(splitName(1))
logonName = left(firstName,1) & lastName
upnName = LogonName & UPNDomain

Set RootDSE = GetObject("LDAP://RootDSE")
domainDN = RootDSE.Get("DefaultNamingContext")
Set userContainer = GetObject("LDAP://cn=users," & _
   domainDN)

set newUser = userContainer.Create("user", "cn=" & _
   userName)
newUser.SamAccountName = logonName
newUser.SetInfo

newUser.FirstName = firstName
newUser.LastName = lastName
newuser.DisplayName = userName
newUser.Description = "Test User"
newUser.AccountDisabled = FALSE
newUser.SetPassword(tempPassword)
newUser.SetInfo

Dim oIADSUser
Dim oMailbox

Set oIADS = GetObject("LDAP://RootDSE")
strDefaultNC = oIADS.Get("defaultnamingcontext")
'MsgBox FindAnyMDB("CN=Configuration," & strDefaultNC)

'TODO: Use the newly created domain user account to replace the "Tom Cruse".
Set oIADSUser = (newUser)


If oIADSUser Is Nothing then
      MsgBox "The oIADSUser is Nothing."
Else
      MsgBox "The oIADSUser is created successfully."
End If

Set oMailBox = oIADSUser
oMailbox.CreateMailbox FindAnyMDB("CN=Configuration," & strDefaultNC)
oIADSUser.SetInfo




Function FindAnyMDB(strConfigurationNC)
      Dim oConnection
      Dim oCommand
      Dim oRecordSet
      Dim strQuery

      ' Open the Connection.
      Set oConnection = CreateObject("ADODB.Connection")
      set oCommand = CreateObject("ADODB.Command")
      Set oRecordSet = CreateObject("ADODB.Recordset")

      oConnection.Provider = "ADsDSOObject"
      oConnection.Open "ADs Provider"

      ' Build the query to find the private MDB.
      strQuery = "<LDAP://" & strConfigurationNC & ">;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

      oCommand.ActiveConnection = oConnection
      oCommand.CommandText = strQuery
      Set oRecordSet = oCommand.Execute

      ' If you have an MDB, return the first one.
      If Not oRecordSet.EOF Then
            oRecordSet.MoveFirst
            FindAnyMDB = CStr(oRecordSet.Fields("ADsPath").Value)
      Else
            FindAnyMDB = ""
      End If


      'Clean up.
      oRecordSet.Close
      oConnection.Close
      Set oRecordSet = Nothing
      Set oCommand = Nothing
      Set oConnection = Nothing
End Function




Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long
 
Private Sub MyPause(Interval As Long)
Dim Start
Start = GetTickCount
Do While GetTickCount < Start + Interval
DoEvents
Loop

End Sub



End Function
Private Sub MyPause(Interval As Long)
Dim Start
Start = GetTickCount
Do While GetTickCount < Start + Interval
DoEvents
Loop
End Sub
'Pause for 5000 milliseconds
MyPause 5000

'Sending a text email  
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Welcome to Phipps Houses"
objMessage.Sender = "administrator@test.com"
objMessage.To = "Bred@test.com"
objMessage.TextBody = "This is some sample message text."
objMessage.Send



0
 
LVL 42

Expert Comment

by:frodoman
ID: 12350676
Get rid of this code:

Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long
 
Private Sub MyPause(Interval As Long)
Dim Start
Start = GetTickCount
Do While GetTickCount < Start + Interval
DoEvents
Loop

End Sub

End Function

You've already code the "Private Declare" at the very top which is fine.  Here you've got the Sub inside the function code which is probably the cause of your error.  Your code should look like this:

Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

Private Sub MyPause(Interval As Long)
Dim Start
Start = GetTickCount
Do While GetTickCount < Start + Interval
DoEvents
Loop
End Sub

userName = InputBox(StrMsg,"Enter Username:")
tempPassword = "phipps"

splitName = Split(userName, " ")
firstName = lcase(splitName(0))
lastName = lcase(splitName(1))
logonName = left(firstName,1) & lastName
upnName = LogonName & UPNDomain

Set RootDSE = GetObject("LDAP://RootDSE")
domainDN = RootDSE.Get("DefaultNamingContext")
Set userContainer = GetObject("LDAP://cn=users," & _
   domainDN)

set newUser = userContainer.Create("user", "cn=" & _
   userName)
newUser.SamAccountName = logonName
newUser.SetInfo

newUser.FirstName = firstName
newUser.LastName = lastName
newuser.DisplayName = userName
newUser.Description = "Test User"
newUser.AccountDisabled = FALSE
newUser.SetPassword(tempPassword)
newUser.SetInfo

Dim oIADSUser
Dim oMailbox

Set oIADS = GetObject("LDAP://RootDSE")
strDefaultNC = oIADS.Get("defaultnamingcontext")
'MsgBox FindAnyMDB("CN=Configuration," & strDefaultNC)

'TODO: Use the newly created domain user account to replace the "Tom Cruse".
Set oIADSUser = (newUser)

If oIADSUser Is Nothing then
     MsgBox "The oIADSUser is Nothing."
Else
     MsgBox "The oIADSUser is created successfully."
End If

Set oMailBox = oIADSUser
oMailbox.CreateMailbox FindAnyMDB("CN=Configuration," & strDefaultNC)
oIADSUser.SetInfo

Function FindAnyMDB(strConfigurationNC)
     Dim oConnection
     Dim oCommand
     Dim oRecordSet
     Dim strQuery

     ' Open the Connection.
     Set oConnection = CreateObject("ADODB.Connection")
     set oCommand = CreateObject("ADODB.Command")
     Set oRecordSet = CreateObject("ADODB.Recordset")

     oConnection.Provider = "ADsDSOObject"
     oConnection.Open "ADs Provider"

     ' Build the query to find the private MDB.
     strQuery = "<LDAP://" & strConfigurationNC & ">;(objectCategory=msExchPrivateMDB);name,adspath;subtree"

     oCommand.ActiveConnection = oConnection
     oCommand.CommandText = strQuery
     Set oRecordSet = oCommand.Execute

     ' If you have an MDB, return the first one.
     If Not oRecordSet.EOF Then
          oRecordSet.MoveFirst
          FindAnyMDB = CStr(oRecordSet.Fields("ADsPath").Value)
     Else
          FindAnyMDB = ""
     End If

     'Clean up.
     oRecordSet.Close
     oConnection.Close
     Set oRecordSet = Nothing
     Set oCommand = Nothing
     Set oConnection = Nothing
End Function

'Pause for 5000 milliseconds
MyPause 5000

'Sending a text email  
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Welcome to Phipps Houses"
objMessage.Sender = "administrator@test.com"
objMessage.To = "Bred@test.com"
objMessage.TextBody = "This is some sample message text."
objMessage.Send


0
 

Author Comment

by:Phipps-IT
ID: 12350793
Still the same!!!  
Line 1
Char: 17
Error: Expected end of statement
Code: 800A0401
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12350908
It's been a while since I've done this but I belive the first line ( Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long ) needs to be in the declarations section of your code.  The rest can be in your form or in your "Main" sub or wherever.
0
 

Author Comment

by:Phipps-IT
ID: 12351316
I don't know what else to do to get it going.

Please let me know if you come up with a solution.

Thank you so much
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 42

Expert Comment

by:frodoman
ID: 12351448
I've been away from VB for quite a while now so it's probably something obvious that I'm just not seeing.  

If it isn't important to you that it's accurate down to the millisecond then you could always forget the windows api and take the lame loop approach.

Wherever you want the delay just insert into your code:

i = 0
Do While i < 999999   <- Gradually increase this value to get the delay you want
   DoEvents
   i = i + 1
Loop

The downside to this approach is that the delay will be shorter on a fast computer and longer on a slow computer.  If it's running on a server it should be consistent enough for your purposes though.

0
 

Author Comment

by:Phipps-IT
ID: 12351487
I will try it. Is there a difference between VB and VBScript? Because I am trying to create a Script?
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12351592
Sorry Phipps-IT -- I completely missed that this was VBScript (and yes, your original posting did say that).  Although it's possible to call API's the method is completely different and has to be done through an ocx control and is going to be way, way, way too much work for the task you're dealing with.

Forget everything I've said except for the last posting.  Go with a simple loop like that or use something like this instead:

curr_time = now()
do while curr_time>dateadd("s",-10,now())
'do nothing
loop

frodoman
0
 

Author Comment

by:Phipps-IT
ID: 12351745
Ok,
I was I did not get any errors and the mail-enable user was created, but it did not send the message to it. If I use the send mail script but it self, it will surely send a message.

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Welcom to Phipps Houses"
objMessage.Sender = "administrator@test.com"
objMessage.To = "bboom@test.com"
objMessage.TextBody = "This is some sample message text."
objMessage.Send


Bobby
byounessian@phippsny.org
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12351763
That's not related to the delay then - all this does is cycle in an empty loop for a few seconds and then continue w/ the program.
0
 

Author Comment

by:Phipps-IT
ID: 12351820
I see

What we are trying to do is to have the script to create the user, mail enables it and finally send a welcoming message to it. Since mailbox creation in exchange server take about 30 seconds we need to delay the sending message part so it would create the user, mail enables it, wait for 30 seconds and than send the message.

How can I accomplish that?

Thanks
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12351912
I got into this thread because of the "delay" portion of the question - I don't know much about sending the e-mail itself.

This code snippet:

curr_time = now()
do while curr_time>dateadd("s",-30,now())
'do nothing
loop

Will sit and do nothing for 30 seconds (based on the system clock).  If you place this code after you've created the mailbox but before you send the message it should work.  Of course since you said "about 30 seconds" I would change the 30 to a 40 just to give yourself a cushion in case it takes longer.
0
 

Author Comment

by:Phipps-IT
ID: 12352044
I thank you so so much, I change -10 to -30 and it sent the message. Now the last thing I need to figure out is how to eliminate typing the user name in code that is responsible for sending the message. You see when I double click on the script the input box pops up and lets say I want to create bobtest account, than bobtest needs to be entered in the script it self.

'Sending a text email  
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Welcome to Phipps Houses"
objMessage.Sender = "administrator@test.com"
objMessage.To = "bobtest@test.com"
objMessage.TextBody = "This is some sample message text."
objMessage.Send
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12352098
I think the name you want is stored in the variable "logonName" right?  Based on this line of code:

   newUser.SamAccountName = logonName

So change this line of code:

   objMessage.To = "bobtest@test.com"

To this:

   objMessage.To = logonName & "@test.com"

Obviously if logonName isn't the correct value just use whichever variable has "bobtest" stored in it...
0
 

Author Comment

by:Phipps-IT
ID: 12357895
Your VB knowledge is remarkable. I’ve been working on this issue for some period of times and posted so questions but no one was able to help me out.

Once again thank you very much.

Also can this script be run on any work station on the network? Or it must be on the server it self?  


Bobby
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12357983
If you mean the snippets I gave you, they are very basic and any machine that can run vb script should be able to execute them.

If you mean the entire script then the code itself can run anywhere but it's only going to work on machines that can create a CDO.Message object, have access to GetObject("LDAP://RootDSE"), etc.  So it's *possible* that it can run on any machine but I would guess that most likely only your server will be configured to allow it to run correctly.

HTH

frodoman
0
 

Author Comment

by:Phipps-IT
ID: 12358194
Thank you
0
 
LVL 42

Expert Comment

by:frodoman
ID: 12358279
Glad to help - frodoman

0
 
LVL 42

Accepted Solution

by:
frodoman earned 250 total points
ID: 12358300
Please don't forget to close this question.  I checked your profile and it doesn't look like you've closed any so you'll have a moderator after you soon.

If you need help w/ closing questions check this link:  http://www.experts-exchange.com/help.jsp#hi68

frodoman
0
 

Author Comment

by:Phipps-IT
ID: 12400687
Dear professional,

I know I closed this but I'v ran into another problem. The script works fine on the test server running Win2KServer Exchange 2000 but it is not working on my exchange 2003 server. It creates the user but it doesn't send any message.

Need your help

Thanks

bobby
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

This article will show, step by step, how to integrate R code into a R Sweave document
This is about my first experience with programming Arduino.
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

706 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

15 Experts available now in Live!

Get 1:1 Help Now