I can list all published apps just fine, that works, but when trying to get the root applications folder I get an invalid procedure call. Does anyone know what I'm doing wrong here?
Dim theFarm,rootAppFolder
Set oWSHShell = CreateObject("Wscript.Shell")
Set oWSHNetwork = CreateObject("WScript.Network")
Set oWSHProcEnv = oWSHSHELL.Environment("PROCESS")
'Create MetaFrameFarm object
Set theFarm = CreateObject("MetaFrameCOM.MetaFrameFarm")
if Err.Number <> 0 Then
WScript.Echo "Can't create MetaFrameFarm object"
WScript.Echo "(" & Err.Number & ") " & Err.Description
WScript.Echo ""
WScript.Quit Err.Number
End if
'Initialize the farm object.
theFarm.Initialize 1
If Err.Number <> 0 Then
WScript.Echo "Can't Initialize MetaFrameFarm object"
WScript.Echo "(" & Err.Number & ") " & Err.Description
WScript.Echo ""
WScript.Quit Err.Number
End if
Set rootAppFolder = theFarm.GetRootFolder(MetaFrameAppFolder) 'error on this line here
Set appFolder = rootAppFolder.GetSubFolder("A_USA")
Set folder = appFolder.AppFolder
For each app in folder.Applications
app.LoadData(0)
WScript.Echo app.AppName
Next
Use Option Explicit to avoid blunders like an un-initialized MetaFrameAppFolder.
Kind of a novice with VbScript, and trying to implement error handling. My method is to pass the error object to a HandleErr sub, but the error apparently gets cleared by the "On Error Resume Next" statement withing the sub. Using Windows 7.
On Error Resume Next
Dim x
x = 1/0
msgbox "Original Error: " & err.Number & " - " & err.Description
if err.number <> 0 then HandleErr err
Sub HandleErr(objErr)
on error resume next '### Without this On Error statement, the script runs fine.
msgbox "Error in HandleErr: " & objErr.Number & " - " & objErr.Description '### objErr.Number becomes zero.
WScript.Quit objErr.Number
End Sub
I imagine there is a simple answer for this. Any help would be greatly appreciated.
You want to stop the skipping errors with On Error Resume Next once you reach HandleErr(). Also use Err.Clear() to reset Err object.
On Error Resume Next
Dim x
x = 1/0
MsgBox "Original Error: " & Err.Number & " - " & Err.Description
if Err.Number <> 0 then HandleErr Err
'Stop skipping lines when errors occur.
On Error Goto 0
Sub HandleErr(objErr)
MsgBox "Error in HandleErr: " & objErr.Number & " - " & objErr.Description '### objErr.Number becomes zero.
'Clear current error now you have trapped it.
Err.Clear
WScript.Quit objErr.Number
End Sub
Personally though I wouldn't pass Err into your function because Err is a global built-in object so you can still check the values without passing it in.
On Error Resume Next
Dim x
x = 1/0
MsgBox "Original Error: " & Err.Number & " - " & Err.Description
Call HandleErr()
'Stop skipping lines when errors occur.
On Error Goto 0
Sub HandleErr()
'Do we need to trap an error?
If Err.Number <> 0 Then
MsgBox "Error in HandleErr: " & Err.Number & " - " & Err.Description '### Err.Number becomes zero.
'Clear current error now you have trapped it.
Err.Clear
WScript.Quit Err.Number
End If
End Sub
I am attempting to write a small script in VBScript just purely for my home use, which is run prior to a scheduled backup in Macrium Reflect.
I am stuck on one seemingly small issue and that is error handling when the Network Drive is physically disconnected, i.e. the cable is not attached.
At the moment the script check to see if the Drive is already attached, if the drive is not attached then a message is displayed telling the user to connect the cable and press YES.
Now, all things being well the user would have connected the cable as asked and then pressed the YES button but I want to catch the times when YES was pressed before attaching the drive's cable.
Within the code there's an 'On Error Resume Next' which masks this eventuality, so I comment out this line & indeed I get an Error 'The Network Path Was Not Found' on line 40:
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, _
I want to use this caught error to display an alert to the user that the drive has not yet been connected, please connect and retry & KEEP RETRYING until the drive is actually connected.
My problem is I cannot seem to find where to add any error handling code to display this message.
Here's my code:
Option Explicit
Dim strDriveLetter, strRemotePath, strUser, strPassword, strProfile, strName, objNetwork, objShell, CheckDrive, AlreadyConnected, intDrive
' The section sets the variables.
strDriveLetter = "X:"
strRemotePath = "\\192.168.1.1\shared"
strUser = "user"
strPassword = "password"
strProfile = "true"
strName = "Backup Drive"
' This sections creates two objects:
' objShell and objNetwork and counts the drives
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
Set CheckDrive = objNetwork.EnumNetworkDrives()
' This section deals with a For ... Next loop
' See how it compares the enumerated drive letters
' with strDriveLetter
On Error Resume Next
AlreadyConnected = False
For intDrive = 0 To CheckDrive.Count - 1 Step 2
If CheckDrive.Item(intDrive) =strDriveLetter _
Then AlreadyConnected = True
Next
If AlreadyConnected = False Then
Dim result
result = MsgBox("A Backup Is Now Due But The Drive Is Not Connected." & vbNewLine & vbNewLine & "Please Connect The Drive & Press YES To Continue." & vbNewLine & vbNewLine & "If You Wish To Postpone Backup Then Press NO Now.", 4 + 32, "BACKUP DRIVE NOT CONNECTED")
If result = 7 Then
WScript.Quit
Else
Call MapDRV
End If
Sub MapDRV()
Set objNetwork = WScript.CreateObject("WScript.Network")
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, _
strProfile, strUser, strPassword
Set objShell = CreateObject("Shell.Application")
objShell.NameSpace(strDriveLetter).Self.Name = strName
End Sub
WScript.Quit
The error handling code is something along these lines:
If Err.Number <> 0 Then
'error handling:
'ALERT USER HERE
Err.Clear
End If
Any help would be appreciated
Err Object (VBScript) reference does not give useful guide. You need to trap an error or success separate for every run-time error prone action.
Common rule (best practice): keep error handling disabled via On Error GoTo 0 and enable it only for suspected actions.
For instance, there could me more than one reason why MapNetworkDrive method could fail (server off-line, user blocked, wrong/changed password etc.):
Sub MapDRV
Dim errResult
Set objNetwork = WScript.CreateObject("WScript.Network")
errResult = ""
On Error Resume Next
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath _
, strProfile, strUser, strPassword
If Err.Number = 0 Then
On Error GoTo 0
Set objShell = CreateObject("Shell.Application")
objShell.NameSpace(strDriveLetter).Self.Name = strName
Else
errResult = Err.Number & " 0x" & Hex(Err.Number) & " " & Err.Source
errResult = errResult & vbNewLine & Err.Description
On Error GoTo 0
MsgBox errResult, vbOKOnly + vbCritical, "Error occurred"
End If
End Sub
The whole script then could look as follows:
Option Explicit
On Error GoTo 0
Dim strResult: strResult = Wscript.ScriptName
Dim strDriveLetter, strRemotePath, strUser, strPassword, strProfile , strName _
, objNetwork, objShell, CheckDrive, AlreadyConnected, intDrive
' The section sets the variables.
strDriveLetter = "X:"
strRemotePath = "\\192.168.1.1\shared"
strUser = "user"
strPassword = "password"
strProfile = "true"
strName = "Backup Drive"
' This sections creates two objects:
' objShell and objNetwork and counts the drives
Set objShell = CreateObject("WScript.Shell")
Set objNetwork = CreateObject("WScript.Network")
' This section deals with a For ... Next loop
' See how it compares the enumerated drive letters with strDriveLetter
Dim result, toShare
AlreadyConnected = False
Do While AlreadyConnected = False
strResult = strResult & vbNewLine & "--- new check"
AlreadyConnected = False
Set CheckDrive = objNetwork.EnumNetworkDrives()
For intDrive = 0 To CheckDrive.Count - 1 Step 2
If CheckDrive.Item(intDrive) = strDriveLetter Then
AlreadyConnected = True
toShare = CheckDrive.Item(intDrive + 1)
End If
strResult = strResult & vbNewLine & CheckDrive.Item(intDrive)
strResult = strResult & vbTab & CheckDrive.Item(intDrive + 1)
Next
If AlreadyConnected Then Exit Do
result = MsgBox("A Backup Is Now Due But The Drive Is Not Connected." _
& vbNewLine & vbNewLine & "If you wish to ..." _
& vbNewLine & vbTab & "... postpone backup then press ABORT." _
& vbNewLine & vbTab & "... backup to " & strRemotePath & " then press RETRY." _
& vbNewLine & "Otherwise, please connect the drive & press IGNORE to continue." _
, vbAbortRetryIgnore + vbQuestion, "BACKUP DRIVE NOT CONNECTED")
Select Case result
Case vbAbort
Call scriptQuit
Case vbRetry
Call MapDRV
Case Else
' The Case Else clause is not required
End Select
Loop
strResult = strResult & vbNewLine & "copy here to " & toShare
Sub MapDRV
' no need to redefine: WshNetwork Object is already defined
' Set objNetwork = WScript.CreateObject("WScript.Network")
Dim errResult
On Error Resume Next
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath _
, strProfile, strUser, strPassword
If Err.Number = 0 Then
On Error GoTo 0
Set objShell = CreateObject("Shell.Application")
objShell.NameSpace(strDriveLetter).Self.Name = strName
Else
errResult = Err.Number & " 0x" & Hex(Err.Number) & " " & Err.Source
errResult = errResult & vbNewLine & Err.Description
On Error GoTo 0
MsgBox errResult, vbOKOnly + vbCritical, "Error occurred"
strResult = strResult & vbNewLine & vbNewLine & errResult
End If
End Sub
Call scriptQuit
Sub scriptQuit
Wscript.Echo strResult
Wscript.Quit
End Sub
Please note that strResult variable is there merely for debugging purposes to see next output:
==> cscript D:\VB_scripts\SO\37776762.vbs
37776762.vbs
--- new check
Y: \\S-PC\VB_scripts_help
-2147024843 0x80070035 WSHNetwork.MapNetworkDrive
The network path was not found.
--- new check
Y: \\S-PC\VB_scripts_help
--- new check
Y: \\S-PC\VB_scripts_help
X: \\S-PC\test
copy here to \\S-PC\test
==>
Above output corresponds to next actions:
run script
1st --- new check found Y: mapped disk; then invoked Retry action failed (network path was not found);
2nd --- new check found Y: mapped disk again; then mapped disk X: manually and then invoked Ignore action;
3rd --- new check found Y: and X: mapped disks;
Do While loop exited and script continues to next action.
For completeness, following output shows invoked Abort action:
==> net use x: /delete
x: was deleted successfully.
==> cscript D:\VB_scripts\SO\37776762.vbs
37776762.vbs
--- new check
Y: \\S-PC\VB_scripts_help
==>
I've got the following Function that is designed to recursively read all WMI namespaces on a machine depending on the namespace that's been passed (by default the script calls for ReadWMI("root"). If a WMI namespace contains the name sms or ccm, I want to test writing to that namespace to validate writing works. If Writing to WMI fails in that function, I want to exit the For Loop and completely exit the function.
What I'm noticing is that when I exit the for or exit the function (using either Exit For or Exit Function) I go back to Next instead of exiting the function completely. This causes a number of issues where other namespaces can successfully be written to.
Function ReadWMI(strNameSpace)
Dim oWMI, colNameSpaces, objNameSpace, sFullNamespace
'ReadWMI = "True"
WMI_ReadRepository = "Healthy"
On Error Resume Next
'Verify all namespaces
Set oWMI = GetObject("winmgmts:\\" & sComputer & "\" & strNameSpace)
If Err.Number <> 0 Then
ReadWMI = "False"
WMI_ReadRepository = "Unhealthy"
oLog.WriteLine Now()& " - " & "ReadWMI(): Failed to bind to WMI namespace " & strNamespace & ". Stopping WMI Verification"
oLog.WriteLine Now()& " - " & "ReadWMI(): Error Code: " & Err.Number
'oLog.WriteLine Now()& " - " & "ReadWMI(): Error Description: " & Err.Description
Err.Clear
Exit Function
Else
oLog.WriteLine Now()& " - " & "ReadWMI(): Successfully connected to WMI namespace " & strNamespace
End If
Set colNameSpaces = oWMI.InstancesOf("__NAMESPACE")
For Each objNameSpace In colNameSpaces
sFullNamespace = LCase(strNamespace & "\" & objNamespace.Name)
If InStr(sFullNamespace,"ccm") Or InStr(sFullNamespace,"sms") > 0 Then
oLog.WriteLine Now()& " - " & "ReadWMI(): Writing to " & sFullNamespace & " WMI Namespace if WMIWriteRepository set to TRUE"
If WMIWriteRepository = True Then
If WriteWMI(sFullNamespace) = "False" Then
oLog.WriteLine Now()& " - " & "ReadWMI(): Failed to write to namespace " & sFullNamespace
WMI_ReadRepository = "Unhealthy"
'ReadWMI = "False"
Exit Function
End If
Else
oLog.WriteLine Now()& " - " & "ReadWMI(): WMIWriteRepository set to False or OS is a Server. Will not write to repository."
End If
End If
'Call VerifyWMI again to run through the next namespace
Call ReadWMI(sFullNamespace)
Next
'ReadWMI = "True"
'WMI_ReadRepository = "Healthy"
Set oWMI = Nothing
On Error Goto 0
End Function
If something goes wrong and you want to jump out of the recursive function call, make the return value False (uncomment the 'ReadWMI = "False" in your script).
Your last statement before the next must test if the reading of the WMI was correct, so instead of
Call ReadWMI(sFullNamespace)
use
If ReadWMI(sFullNamespace) = "False" Then
Exit For
End If
Protip: Stop using "string booleans", they are slow and errors are luring around the corner to bite you in the back ("True" <> "true" <> "Treu" <> "True "). Just use True and False. Whenever you want to output a boolean to a string, it is automatically converted to the correct string value:
MsgBox True & " / " & False
' Output: "True / False"
I'm trying to change all the built-in windows local administrators names in my domain.
The new name will be "administrator", but it seems that my script is unable to read the excel data(server|old account name).
DIM strPassword, strAdminUserName, strNewAdminUserName
Dim strExcelPath, objExcel, objSheet, intRow
'''''
'Spreadsheet file.
strExcelPath = "c:\List.xls"
' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0
' Open spreadsheet.
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
Wscript.Quit
End If
On Error GoTo 0
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
intRow = 2
Do While objSheet.Cells(intRow, 1).Value <> ""
comp = objSheet.Cells(intRow, 1).Value
strAdminUserName = objSheet.Cells(intRow, 2).Value
strNewAdminUserName = "Administrator"
On Error Resume Next
' Rename a local user account on a given computer
SET objComputer = GetObject("WinNT://" & Comp)
SET objUser = GetObject("WinNT://" & Comp & "/" & strAdminUserName & ",user")
IF err.number = 0 THEN
objComputer.MoveHere objUser.ADsPath,strNewAdminUserName
END IF
ON ERROR GOTO 0
loop
' Close the workbook.
objExcel.ActiveWorkbook.Close
' Quit Excel.
objExcel.Application.Quit
Wscript.Echo "Done"
Any opinion/comment will be appreciated.