Link to home
Start Free TrialLog in
Avatar of Phipps-IT
Phipps-ITFlag for United States of America

asked on

VB Timer

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
Avatar of frodoman
frodoman
Flag of United States of America image

Declare this API:

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

Use it this way - value is milliseconds:

Sleep(1000)
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
Avatar of alfanhendro
alfanhendro

or maybe you can just put

DoEvents

Avatar of Phipps-IT

ASKER

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




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
Yes I've tried that and kept getting Error: Expected end of statement Code: 800A0401

Anything else sould be added?
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.
Still getting the same error. ??
Can you show your complete code as it looks now w/ the new delay included?
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



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


Still the same!!!  
Line 1
Char: 17
Error: Expected end of statement
Code: 800A0401
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.
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
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.

I will try it. Is there a difference between VB and VBScript? Because I am trying to create a Script?
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
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
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.
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
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.
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
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...
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
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
Thank you
Glad to help - frodoman

ASKER CERTIFIED SOLUTION
Avatar of frodoman
frodoman
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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