If vbscript errors retry or loop?

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

**********************************************************************************************************************
BidwellsITAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

mvidasCommented:
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
mvidasCommented:
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
BidwellsITAuthor 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.

Your Guide to Achieving IT Business Success

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

mvidasCommented:
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
BidwellsITAuthor 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.

L00MCommented:
I assume the error occurs at:

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

???
BidwellsITAuthor 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?
L00MCommented:
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.
BidwellsITAuthor 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
L00MCommented:
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?
BidwellsITAuthor 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
L00MCommented:
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?
William ElliottSr Tech GuruCommented:
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
William ElliottSr Tech GuruCommented:
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,..
L00MCommented:
Similar to my queuing solution
RobSampsonCommented:
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.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
William ElliottSr Tech GuruCommented:
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.  
RobSampsonCommented:
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.
BidwellsITAuthor 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
L00MCommented:
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.
...
RobSampsonCommented:
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.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.