If vbscript errors retry or loop?

BidwellsIT
BidwellsIT used Ask the Experts™
on
Hi I am trying to do something i would class as simple but just cannot find any posts or anything similar to help me.

I need to get a vbscript to loop a command if it errors?

The error is a permission denied error code 800a0046. Its doing this as i am trying to write to a text file simultaneously.

I would like it to retry the command if the user gets this error and then exit once they dont. Or store the result it finds in memory and then write it to the text file when it is free.

The code is on a login script you see. Here is my code.

*********************************************************************************************************************

      Const ForAppending = 8
      Dim strC, strUser, objTextFile, strFile, objFSO
      Set oNet = CreateObject("WScript.Network")
      set objFSO = CreateObject("Scripting.FilesystemObject")

      strFile = "\\SERVER\SHARE\Default Printer.txt"
      strUser = lcase(oNet.UserName)
      strC = ucase(oNet.ComputerName)

      Set objTextFile = objFSO.OpenTextFile _
      (strFile, ForAppending, True)

      'objTextFile.WriteBlankLines(2)
      objTextFile.WriteLine strUser & "          " & strC & "       " & GetDefaultPrinter
      objTextFile.WriteBlankLines(1)

      objTextFile.Close

      Function GetDefaultPrinter
      sComputer = "."
      Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
      Set colItems = oWMIService.ExecQuery("Select * from Win32_Printer",,48)
      For Each oItem in colItems
      If (oItem.Attributes And 2^(3-1)) = 4 Then
      sDefault = oItem.Name
      Exit For
      End If
      Next
      GetDefaultPrinter = sDefault
      End Function

**********************************************************************************************************************
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Hi BidwellsIT,

Give this a try in place of your current "Set objTextFile = ..." line, should do what you want:

      On Error Resume Next
      Do
       DoEvents
       Set objTextFile = objFSO.OpenTextFile _
        (strFile, ForAppending, True)
      Loop Until Not IsEmpty(objTextFile)
      On Error GoTo 0

Matt
Oops.. well since its in the On Error Resume Next part it doesn't really matter, but take DoEvents out of there since it can't be used in VBS anyways

Author

Commented:
HI thanks for the response.

I am afraid it doesn't work. To test this i loop the open text file command using a separate script to keep the file open.

if i then run your solution combined with my script it gives me permission denied straight away.

Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

If the On Error Resume Next isn't working for you, I don't know what to tell you. I don't know another way to test if the file is open or not, sorry.  Hopefully someone else does
Matt

Author

Commented:
this is what i am using now..

*********************************************************************************************************************

Const ForAppending = 8

      Dim strC, strUser, objTextFile, strFile, objFSO

      Set oNet = CreateObject("WScript.Network")
      set objFSO = CreateObject("Scripting.FilesystemObject")




      strFile = "\\SERVERSHARE\\Default Printer.txt"
      strUser = lcase(oNet.UserName)
      strC = ucase(oNet.ComputerName)

      On Error Resume Next
      
      Do
        Set objTextFile = objFSO.OpenTextFile _
        (strFile, ForAppending, True)
      Loop Until Not IsEmpty(objTextFile)
      On Error GoTo 0


      'Set objTextFile = objFSO.OpenTextFile _
      '(strFile, ForAppending, True)

      'objTextFile.WriteBlankLines(2)
      objTextFile.WriteLine strUser & "          " & strC & "       " & GetDefaultPrinter
      objTextFile.WriteBlankLines(1)

      objTextFile.Close

      

      'MsgBox "Thank you Now please Click OK"



      Function GetDefaultPrinter

      sComputer = "."

      Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")

      Set colItems = oWMIService.ExecQuery("Select * from Win32_Printer",,48)

      For Each oItem in colItems

      If (oItem.Attributes And 2^(3-1)) = 4 Then

      sDefault = oItem.Name

      Exit For

      End If

      Next

      GetDefaultPrinter = sDefault

      End Function
*******************************************************************************************************************

and it still errors. I have also tried putting the On error resume next at the very start of the script. NO joy either.

Commented:
I assume the error occurs at:

Set objTextFile = objFSO.OpenTextFile (strFile, ForAppending, True)

???

Author

Commented:
I know where and why the error occurs - its being run when the company logon.

So there are users trying to write to the file when others are already writing to it.

I just need the script to realise this and retry until it can write to it and not error out.

Any ideas?

Commented:
I just wanted to make sure. You are receiving a message that says 'Error occured on line: xx'? If not, do you have friendly error messages turned off? (In IE)
http://www.webwizguide.com/asp/faq/friendly_HTTP_error_messages.asp

Also, I dont personally like the loop approach since it pegs out the processor usage while waiting. Instead, I would write everything into a message queue or database queue table, then have a service constantly monitoring the queue for new entries. The service would attempt to write out the file whenever it's available. But, I dont really understand the problem all that well.

Author

Commented:
Hi

firstly to simulate many people writing to the file at once i run this..

*********************************************************************************************
Const ForAppending = 8
Dim strC, strUser, objTextFile, strFile, objFSO, Count
Set oNet = CreateObject("WScript.Network")
set objFSO = CreateObject("Scripting.FilesystemObject")
Count = 0

strFile = "\\file-cluster\Groups\Default Printer.txt"
strUser = lcase(oNet.UserName)
strC = ucase(oNet.ComputerName)

Do

Set objTextFile = objFSO.OpenTextFile _
(strFile, ForAppending, True)

'objTextFile.WriteBlankLines(2)
'objTextFile.WriteLine strUser & "          " & strC & "       " & GetDefaultPrinter
'objTextFile.WriteBlankLines(1)

objTextFile.Close

Loop
********************************************************************************************************************

Then while this is running i run my script as below..

*********************************************************************************************************************
Const ForAppending = 8

      Dim strC, strUser, objTextFile, strFile, objFSO

      Set oNet = CreateObject("WScript.Network")
      set objFSO = CreateObject("Scripting.FilesystemObject")




      strFile = "\\file-cluster\Groups\Default Printer.txt"
      strUser = lcase(oNet.UserName)
      strC = ucase(oNet.ComputerName)

      Set objTextFile = objFSO.OpenTextFile _
      (strFile, ForAppending, True)

      'objTextFile.WriteBlankLines(2)
      objTextFile.WriteLine strUser & "          " & strC & "       " & GetDefaultPrinter
      objTextFile.WriteBlankLines(1)

      objTextFile.Close

      

      'MsgBox "Thank you Now please Click OK"



      Function GetDefaultPrinter

      sComputer = "."

      Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")

      Set colItems = oWMIService.ExecQuery("Select * from Win32_Printer",,48)

      For Each oItem in colItems

      If (oItem.Attributes And 2^(3-1)) = 4 Then

      sDefault = oItem.Name

      Exit For

      End If

      Next

      GetDefaultPrinter = sDefault

      End Function

************************************************************************************************************************

This gives me my error as it cant write to the file as its already being written to..

This is the error i recieve.

Line:  19
Char: 1
Error: Permission Denied
Code: 800A0046
Source: Microsoft VBScript runtime error

So i need the script to keep trying until it can write to the file by looping on error or another method.

Does that explain things a bit more?

Thanks
Gary

Commented:
So, it looks like line 19 is:

objTextFile.WriteLine strUser & "          " & strC & "       " & GetDefaultPrinter

Which means, to me, that the file has sucessfully opened. Have you verified the IUSR_<machinename> has write/modify permissions on that file?

Author

Commented:
Yes because if i run the script manually from my machine ( all tests are being run under my account on my machine ) it works fine i only get permission denied when i simulate other scripts running the same command continuously.

Which is what will happen when everyone in the firm logs on.. some users will not be able to write to the file while others are.

So if thats not what i am after then i need the script to be able to be written to while other sources are writing to it. Or on error retry..

Thanks

Commented:
You say you moved the 'On Error Move Next' to the top of the script, but did you move 'On Error Goto 0' to the bottom of the script?
you could encapsulate the script in a job file and run it with a specific set of credentials that will always work.

http://www.joeware.net/freetools/tools/cpau/index.htm

just a thought
n/m i misinterpreted the issue,. i had this same problem and the only resolution i could find was to write to an access database.

or write to seperate text files, then run a script to combine all the text files
basically write to %computername%.txt or %username%.txt

whichever you prefer,..

Commented:
Similar to my queuing solution
Most Valuable Expert 2012
Top Expert 2014
Commented:
Hi, it looks like your problem is occurring upon trying to Open the file, not write to it.
Using your example of testing this with one script that continually accesses the file, and another that tries to write to it, I have modified them to get them work (I think).  The second script just keeps trying until it finds some time where the first script isn't accessing it:

'===============================
'Script1 - Continue_Writing_To_File.vbs
Const ForAppending = 8
Dim strC, strUser, objTextFile, strFile, objFSO, Count
Set oNet = CreateObject("WScript.Network")
set objFSO = CreateObject("Scripting.FilesystemObject")
Count = 0

strFile = "N:\Scripting\Test Scripts\AAATest\DefaultPrinter.txt"
strUser = lcase(oNet.UserName)
strC = ucase(oNet.ComputerName)

Do

On Error Resume Next
Set objTextFile = objFSO.OpenTextFile(strFile, ForAppending, True)
If Err Then
      MsgBox Err.Number & VbCrLf & "The file was not opened."
Else
      On Error GoTo 0
      objTextFile.Close
End If

Loop
'===============================

'===============================
'Script2 - Try_To_Write_To_File.vbs
Const ForAppending = 8

Dim strC, strUser, objTextFile, strFile, objFSO

Set oNet = CreateObject("WScript.Network")
set objFSO = CreateObject("Scripting.FilesystemObject")

strFile = "N:\Scripting\Test Scripts\AAATest\DefaultPrinter.txt"
strUser = lcase(oNet.UserName)
strC = ucase(oNet.ComputerName)

Do
      On Error Resume Next
      Set objTextFile = objFSO.OpenTextFile(strFile, ForAppending, True)
      If Err.Number = 0 Then
            Exit Do
      End If
Loop

'objTextFile.WriteBlankLines(2)
objTextFile.WriteLine strUser & "          " & strC & "       " & GetDefaultPrinter
objTextFile.WriteBlankLines(1)

objTextFile.Close

MsgBox "Second process successfully wrote to the file"


      Function GetDefaultPrinter

      sComputer = "."

      Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")

      Set colItems = oWMIService.ExecQuery("Select * from Win32_Printer",,48)

      For Each oItem in colItems

      If (oItem.Attributes And 2^(3-1)) = 4 Then

      sDefault = oItem.Name

      Exit For

      End If

      Next

      GetDefaultPrinter = sDefault

      End Function
'===============================

Regards,

Rob.
the downside to waitind could be a difference between a 10second logon time and a 2 minute logon time.  .
asynchronous may make it not so much of an issue.  
Most Valuable Expert 2012
Top Expert 2014

Commented:
If the script that writes to this file is separated, and therefore called as a different program / process for that specific purpose (and probably even run first), then it should run as quickly as possible without affecting other logon processes.

Rob.

Author

Commented:
Hi Guys..

OK I have tried yours Rob. The Access DB is not really an option.

I have removed the msgbox comments and it appears that it does retry till it can suceed.

one thing i did notice is it always suceeded on the second attempt. would the script tell me if it was the 3rd attempt or 4th attempt - so it does keep trying doesn't it? it doesn't just try again once then stop?

Thanks

Commented:
Just insert a counter:

...
Numtrys = 1
Do
      On Error Resume Next
      Set objTextFile = objFSO.OpenTextFile(strFile, ForAppending, True)
      If Err.Number = 0 Then Exit Do
      Numtrys = Numtrys + 1
Loop
' Now Numtrys contains the number of times it tried to open the file.
...
Most Valuable Expert 2012
Top Expert 2014

Commented:
L00M is right.  If you add that code in place of the current code that is similar, you can output the Numtrys value if needed, with something like
MsgBox "The file was successfully written to after " & Numtrys & " attempts."

Regards,

Rob.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial