I have been tasked with a requirement to get the current patch level of number of computers within a domain. Currently with the help of code snippets used from many sources I have managed to come-up with the following:
My Approach was to check the July 2017 Patches first and then goto June 2017, then further down up to March 2017. I am quite new to VBScript and need advice :| (Only VBScript can be used due to many restrictions in the Server environments)
' Checks only servers
' Add Respective HotFixID in to respective Array
' Create a new Array if missing in Format "HotFixIDs<YYYY><MM>"
' Add the Array Name as the First in "HotFixIDArray"
'Enter the hotfix number to check for: ONLY the number, no letters here!
ComputerName = "."
Dim status
Dim found
Dim HotFixIDArray()
Set fso = CreateObject("Scripting.FileSystemObject" )
Set file = fso.OpenTextFile("C:\temp\tetran\patchstatus_2017.txt",2,1)
found = 0
HotFixIDArray = Array("HotFixIDs201707","HotFixIDs201706","HotFixIDs201705","HotFixIDs201704","HotFixIDs201703")
For i = 0 To UBound(HotFixIDArray) (
If found = 0 Then
'Check July 2017 Patches
Dim HotFixIDs201707()
HotFixIDs201707 = Array("4032955","4026061","4026059","4025877","4025872","4025674","4025497","4025409","4025398","4025397","4025343","4025341","4025339","4025337","4025336","4025333","4025331","4025240","4022914","4022748","4022746")
For j = 0 To UBound(HotFixIDs201707)
status = CheckParticularHotfix(ComputerName, HotFixIDs201707(j))
If status = True Then
file.writeLine ("The hotfix with number " & HotFixIDs201707(j) & " IS installed.")
found = 1
Exit For
Else
status = False
found = 0
Next
If found = 1 Then
file.writeLine ("2017 July Patch Installed")
Exit For
Else
'Check June 2017 Patches
Dim HotFixIDs201706()
HotFixIDs201706 = Array("3217845","4018106","4019204","4019263","4019264","4021903","4021923","4022008","4022010","4022013","4022715","4022717","4022718","4022719","4022722","4022724","4022726","4022883","4022884","4022887","4024402")
For j = 0 To UBound(HotFixIDs201706)
status = CheckParticularHotfix(ComputerName, HotFixIDs201706(j))
If status = True Then
file.writeLine ("The hotfix with number " & HotFixIDs201706(j) & " IS installed.")
found = 1
Exit For
Else
status = False
found = 0
Next
If found = 1 Then
file.writeLine ("2017 June Patch Installed")
Exit For
Else
'Check May 2017 Patches
Dim HotFixIDs201705()
HotFixIDs201705 = Array("4018196","4018466","4018556","4018821","4018885","4018927","4019149","4019206","4019213","4019214","4019215","4019216","4019472")
For j = 0 To UBound(HotFixIDs201705)
status = CheckParticularHotfix(ComputerName, HotFixIDs201705(j))
If status = True Then
file.writeLine ("The hotfix with number " & HotFixIDs201705(j) & " IS installed.")
found = 1
Exit For
Else
status = False
found = 0
Next
If found = 1 Then
file.writeLine ("2017 May Patch Installed")
Exit For
Else
'Check April 2017 Patches
Dim HotFixIDs201704()
HotFixIDs201704 = Array("3211308","3217841","4014652","4014793","4014794","4015068","4015195","4015217","4015380","4015383","4015546","4015547","4015548","4015549","4015550","4015551","4020535")
For j = 0 To UBound(HotFixIDs201704)
status = CheckParticularHotfix(ComputerName, HotFixIDs201704(j))
If status = True Then
file.writeLine ("The hotfix with number " & HotFixIDs201704(j) & " IS installed.")
found = 1
Exit For
Else
status = False
found = 0
Next
If found = 1 Then
file.writeLine ("2017 April Patch Installed")
Exit For
Else
'Check March 2017 Patches
Dim HotFixIDs201703()
HotFixIDs201703 = Array("3211306","3214051","3217587","3217882","3218362","4011981","4012021","4012212","4012213","4012214","4012215","4012216","4012217","4012373","4012497","4012583","4012584","4012598","4013429","4017018")
For j = 0 To UBound(HotFixIDs201703)
status = CheckParticularHotfix(ComputerName, HotFixIDs201703(j))
If status = True Then
file.writeLine ("The hotfix with number " & HotFixIDs201703(j) & " IS installed.")
found = 1
Exit For
Else
status = False
found = 0
Next
If found = 1 Then
file.writeLine ("2017 March Patch Installed")
Exit For
Else
'Do nothing
'201703 End
'201704 End
'201705 End
'201706 End
'201707 End
If found = 0 Then
'Do nothing
Else
'Do nothing
Else
Exit For
)
Next
File.close
Private Function CheckParticularHotfix(strPuter, strHotfixID)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Version 1.0
' Checks if a particular hotfix is installed or not.
' This function has these 3 return options:
' TRUE, FALSE, <error description>
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strPuter & "\root\cimv2")
If err.number <> 0 Then
CheckParticularHotfix = "WMI could not connect to computer '" & strPuter & "'"
Exit Function 'No reason to continue
End If
strWMIforesp = "Select * from Win32_QuickFixEngineering where HotFixID = 'Q" & strHotfixID &_
"' OR HotFixID = 'KB" & strHotfixID & "'"
Set colQuickFixes = objWMIService.ExecQuery (strWMIforesp)
If err.number <> 0 Then 'if an error occurs
CheckParticularHotfix = "Unable to get WMI hotfix info"
Else 'Error number 0 meaning no error occured
tal = colQuickFixes.count
If tal > 0 Then
CheckParticularHotfix = True 'HF installed
Else
CheckParticularHotfix = False 'HF not installed
End If
End If
Set colQuickFixes = Nothing
Err.Clear
On Error Goto 0
End Function
Finally got around and managed to fix the VBScript :)
'Enter the name of the computer to check: (Replace the dot with a computer name, to connect to a remote computer)
ComputerName = "."
'Creates the FileSystemObject and use it to read the file "patch2017.txt"
Set fso = CreateObject("Scripting.FileSystemObject" )
Set file = fso.OpenTextFile("C:\temp\Patch\patch2017.txt",2,1)
'Variable to identify the installation status
Dim j
j = 0
'July 2017 Patches
'Enter the hotfix number to check for: (ONLY the number, no letters here!)
HotFixID = Array("4032955","4026061","4026059","4025877","4025872","4025674","4025497","4025409","4025398","4025397","4025343","4025341","4025339","4025337","4025336","4025333","4025331","4025240","4022914","4022748","4022746")
For i = 0 To UBound(HotFixID)
status = CheckParticularHotfix(ComputerName, HotFixID(i))
If status = True Then
j = 1
File.WriteLine("July 2017")
Exit For
End If
Next
'June 2017 Patches
HotFixID = Array("3217845","4018106","4019204","4019263","4019264","4021903","4021923","4022008","4022010","4022013","4022715","4022717","4022718","4022719","4022722","4022724","4022726","4022883","4022884","4022887","4024402")
For i = 0 To UBound(HotFixID)
status = CheckParticularHotfix(ComputerName, HotFixID(i))
If status = True Then
j = 1
File.WriteLine("June 2017")
Exit For
End If
Next
'May 2017 Patches
HotFixID = Array("4018196","4018466","4018556","4018821","4018885","4018927","4019149","4019206","4019213","4019214","4019215","4019216","4019472")
For i = 0 To UBound(HotFixID)
status = CheckParticularHotfix(ComputerName, HotFixID(i))
If status = True Then
j = 1
File.WriteLine("May 2017")
Exit For
End If
Next
'April 2017 Patches
HotFixID = Array("3211308","3217841","4014652","4014793","4014794","4015068","4015195","4015217","4015380","4015383","4015546","4015547","4015548","4015549","4015550","4015551","4020535")
For i = 0 To UBound(HotFixID)
status = CheckParticularHotfix(ComputerName, HotFixID(i))
If status = True Then
j = 1
File.WriteLine("April 2017")
Exit For
End If
Next
'March 2017 Patches
HotFixID = Array("3211306","3214051","3217587","3217882","3218362","4011981","4012021","4012212","4012213","4012214","4012215","4012216","4012217","4012373","4012497","4012583","4012584","4012598","4013429","4017018")
For i = 0 To UBound(HotFixID)
status = CheckParticularHotfix(ComputerName, HotFixID(i))
If status = True Then
j = 1
file.WriteLine("March 2017")
Exit For
End If
Next
file.Close
'**************************************
'* Read file and produce and output *
'* Only if the File is not Empty *
'* If File is empty output UNKNOWN *
'**************************************
If (fso.FileExists("C:\temp\Patch\patch2017.txt")) Then
If (fso.GetFile("C:\temp\Patch\patch2017.txt").Size <> 0) Then
Dim firstLine
Set firstLine = fso.OpenTextFile("C:\temp\Patch\patch2017.txt",1)
WScript.Echo firstLine.ReadLine
firstLine.Close
Else
WScript.Echo "UNKNOWN"
End If
End If
'*********************************************************************
'* This Function checks if a particular hotfix is installed or not *
'* This function has these 3 return options: *
'* TRUE, FALSE, <error description> *
'*********************************************************************
Private Function CheckParticularHotfix(strPuter, strHotfixID)
On Error Resume Next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strPuter & "\root\cimv2")
If err.number <> 0 Then
CheckParticularHotfix = "WMI could not connect to computer '" & strPuter & "'"
Exit Function
End If
strWMIforesp = "Select * from Win32_QuickFixEngineering where HotFixID = 'Q" & strHotfixID &_
"' OR HotFixID = 'KB" & strHotfixID & "'"
Set colQuickFixes = objWMIService.ExecQuery (strWMIforesp)
If err.number <> 0 Then
CheckParticularHotfix = "Unable to get WMI hotfix info"
Else
tal = colQuickFixes.count
If tal > 0 Then
CheckParticularHotfix = True 'HF installed
Else
CheckParticularHotfix = False 'HF not installed
End If
End If
Set colQuickFixes = Nothing
Err.Clear
On Error Goto 0
End Function
Related
In my system, I'm using a windows application project. While I'm sending a mail from the project I get an error as "Creating an instance of the COM component with CLSID {20C62CA0-15DA-101B-B9A8-444553540000} from the IClassFactory failed due to the following error:80040112 Class is not licensed for use (Exception from HRResult: 0x800401120).". Can you please help me with the fix for this? I'm using Windows 10 OS.
Dim oMAPSession As New MSMAPI.MAPISession <br/>
Dim MAPIMessages As New MSMAPI.MAPIMessages
Do While J > 0
With MAPIMessages
oMAPSession.SignOn()
.SessionID = oMAPSession.SessionID
.Compose()
If attachbio Then
.AttachmentIndex = 0
If CustomTable.GetCustomNumber("TEPrintPerUser") = 1 Then
.AttachmentPathName = g_fpReportsPath & "\tempbio.pdf"
Else
.AttachmentPathName = Application.StartupPath & "\tempbio.pdf"
End If
.AttachmentName = "techbio.pdf"
End If
strRecip = Trim(rdtxtFldNumber.Text)
i = 0
Do
.RecipIndex = i
.RecipType = 1
If InStr(1, strRecip, ";") > 0 Then
.RecipDisplayName = Microsoft.VisualBasic.Left(strRecip, InStr(1, strRecip, ";") - 1)
strRecip = Mid(strRecip, InStr(1, strRecip, ";") + 1)
i = i + 1
Else
If (strRecip <> "") Then
.RecipDisplayName = strRecip
End If
Exit Do
End If
Loop
GetDispatchForm = New FrmDispatch
If g_sidCustomization = "Nebrasky" And GetDispatchForm.rdddlText.SelectedIndex = 1 Then
.MsgSubject = Replace(rdtxtfpSubject.Text, Chr(10), " ")
Else
.MsgSubject = "Text Message " & Date.Now
End If
If tmpTextCapacity <= 0 Or (Not IsNumeric(Microsoft.VisualBasic.Left(.RecipDisplayName, InStr(1, .RecipDisplayName, "#") - 1))) Then
.MsgNoteText = strText
J = 0
Else
.MsgNoteText = Microsoft.VisualBasic.Left(strText, tmpTextCapacity)
End If
.Send()
End With
strText = Mid(strText, tmpTextCapacity + 1)
J = J - tmpTextCapacity
Loop
I have written a script to check that 4 files exist in a folder. I need to use the below error handling for this particular small piece of code.
This code checks various folders to see if it contains 4 files. If it does then good if it doesn't then its not good.
Code:
Const intOK = 0
Const intCritical = 2
Const intError = 3
Const ForReading=1,ForWriting=2,ForAppending=8
Dim filename,filenamemov,emailaddr
Dim arrFolders(17)
Dim argcountcommand,dteToday
Dim arg(4)
Dim strMailServer,Verbose,strExt,numfiles,intIndex
Dim intcount : intCount = 0
Dim stroutput
numfiles = 4 'how many minutes old are the files
Verbose = 0 '1 FOR DEBUG MODE, 0 FOR SILENT MODE
arrFolders(0) = "D:\AS2\Inbound\WESSEX"
arrFolders(1) = "D:\AS2\Inbound\EATWELL"
arrFolders(2) = "D:\AS2\Inbound\TURNER\"
For intIndex = 0 To UBound(arrFolders)
pt "Checking folder: " & arrFolders(intIndex)
If arrFolders(intIndex) = "" Then
pt "Empty folder value!"
Exit For
Else
Call checkfiles(arrFolders(intIndex))
End If
Next
If objFolder.Files.Count < 4 Then
WScript.Echo "CRITICAL - " & intCount & " File(s) over " & numfiles & "
minutes in " & stroutput
WScript.Quit(intCritical)
Else
WScript.Echo "OK - No directory contains less than 4 files"
WScript.Quit(intOK)
End If
Sub checkfiles(folderspec)
'check If any files exist on folder
On Error Resume Next
Dim objFso : Set objFso = CreateObject("Scripting.FileSystemObject")
'you can take this as input too using InputBox
'this will error If less than 4 files exist.
Dim objFolder : Set objFolder = objFso.GetFolder(strFolderPath)
If objfolder.Files.Count = 4 Then
MsgBox "This is Correct"
Else
MsgBox "This isnt Correct"
End If
Sub pt(txt)
If Verbose = 1 Then
WScript.Echo txt
End If
End Sub
If i understand your question, you want to
check a set of folders kept in an array for the number of files they contain
if any of the folders has less than 4 files, an error message should be displayed
the folder array CAN contain empty values and the routine should skip those
Apparently you have more plans considering all 'extra' variables you have in your code like Const ForReading=1,ForWriting=2,ForAppending=8 and Dim filename,filenamemov,emailaddr, but I left them out here, because they have nothing to do with the question at hand.
Option Explicit
Const intOK = 0
Const intCritical = 2
Const intError = 3
Dim Verbose, path, fileCount, minCount, intCount, errCount
Dim objFso, objFolder, intResult, strResult
Verbose = 0 '1 FOR DEBUG MODE, 0 FOR SILENT MODE
minCount = 4 'The minimal number of files each folder should have
Dim arrFolders(17)
arrFolders(0) = "D:\AS2\Inbound\WESSEX"
arrFolders(1) = "D:\AS2\Inbound\EATWELL"
arrFolders(2) = "D:\AS2\Inbound\TURNER\"
Set objFso = CreateObject("Scripting.FileSystemObject")
intResult = intOK 'assume all is well
strResult = "" 'to accumulate critical errors for each folder
intCount = 0 'the total running count of folders we have checked
errCount = 0 'the total count of errors (folders with less than 4 files) we have found
For Each path In arrFolders
If Len(path) > 0 Then
intCount = intCount + 1
WScript.Echo "Checking folder: " & path
Set objFolder = objFso.GetFolder(path)
fileCount = objfolder.Files.Count
'considering the "OK - No directory contains less than 4 files" message
'in your original post, this test needs to do a 'Greater Than Or Equal To', so use >=
If fileCount >= minCount Then
WScript.Echo "This is correct: " & path
Else
WScript.Echo "This is NOT correct: " & path
strResult = strResult & vbNewLine & "CRITICAL - " & fileCount & " File(s) in folder " & path
intResult = intCritical
errCount = errCount + 1
End If
End if
Next
'clean up used objects
Set objFolder = Nothing
Set objFso = Nothing
If errCount > 0 Then
'we have folders with errors
WScript.Echo strResult
Else
'This message implies that a folder is also 'Good' when more than 4 files exist
WScript.Echo "OK - All " & intCount & " directories contain at least " & minCount & " files"
End If
WScript.Quit(intResult)
Hello I'm trying to debug this script that I inherited below. The error is on line 71 char 6. Object required 'oFile'
I don't have any vbs experience so please be gentle. This script takes a scan and uploads it to a doc archive server, gives it unique filename etc. I haven't figured out what 'ofile' is yet :/
'Feb 18, 2005
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
hiddenCount = 0
'Wscript.Echo Wscript.Arguments(0)
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
Set scanFiles = oFSO.GetFolder(Wscript.Arguments(0)).Files
For Each oFile In scanFiles
If oFile.Attributes and 2 Then
hiddenCount = hiddenCount + 1
End If
Next
Else
Set scanFiles = WScript.Arguments
End If
fileCount = scanFiles.Count - hiddenCount
'Wscript.Echo hiddenCount
'WScript.Echo fileCount
'WScript.Quit()
Set oIE = WScript.CreateObject("InternetExplorer.Application")
oIE.left=50 ' window position
oIE.top = 100 ' and other properties
oIE.height = 300
oIE.width = 350
oIE.menubar = 0 ' no menu
oIE.toolbar = 0
oIE.statusbar = 1
oIE.navigate "http://gisweb/apps/doc_archive/scan_login.php?file_count="&fileCount
'WScript.Echo fileCount
oIE.visible = 1
' Important: wait till MSIE is ready
Do While (oIE.Busy)
Loop
' Wait till the user clicks the OK button
' Use the CheckVal function
' Attention: Thanks to a note from M. Harris, we can make
' the script a bit more fool proof. We need to catch the case
' that the user closes the form without clicking the OK button.
On Error Resume Next
Do ' Wait till OK button is clicked
WScript.Sleep 400
Loop While (oIE.document.script.CheckVal()=0)
' If an error occur, because the form is closed, quit the
' script
If err <> 0 Then
WScript.Echo "Sorry, a run-time error occured during checking" & _
" the OK button " & vbCRLF & _
"Error: " & err.number & " " & _
"I guess the form was getting closed..."
WScript.Quit ' end script
End if
On Error Goto 0 ' switch error handling off
' User has clicked the OK button, retrieve the values
docList = oIE.Document.ValidForm.doc_id_list.Value
'MsgBox doc_id
For i = 0 To 100000
x = 1
Next
oIE.Quit() ' close Internet Explorer
Set oIE = Nothing ' reset object variable
docArray = Split(docList,",")
i = 0
For Each oFile In scanFiles
If Not oFile.Attributes And 2 Then **ERROR HERE**
ext = oFSO.GetExtensionName(oFile)
filename = "p"&right("000000"&docArray(i),6)&"."&ext
base = Int(docArray(i) / 500) * 500
subdir = "d"&right("000000"&base,6)
oFSO.CopyFile oFile, "\\ditgis02\Enterprise_GIS\doc_archive\raw\"&subdir&"\"&filename, True
i = i + 1
End If
Next
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
Set WshShell = WScript.CreateObject("WScript.Shell")
intButton = WshShell.Popup (fileCount&" file(s) logged and copied! Do you want to delete temporary scan files?",0,"Done!",4)
If intButton = 6 Then
For Each oFile In scanFiles
oFile.Delete
Next
End If
Else
WScript.Echo(fileCount&" file(s) logged and copied!")
End If
WScript.Quit() ' Ready
' End
It looks the problem may arise if your initial test fails:
If Wscript.Arguments.Count = 1 And oFSO.FolderExists(Wscript.Arguments(0)) Then
...
Else
Set scanFiles = WScript.Arguments
End If
You're setting the scanFiles variable to a collection of arguments, not files. Later on, near line 71 (where your error occurs), you're treating scanFiles as if it's a Files collection and attempting to access the Attributes property of one of its File objects:
For Each oFile In scanFiles
If Not oFile.Attributes And 2 Then **ERROR HERE**
...
Next
This won't be possible since scanFiles is an Arguments collection instead. So I think you need to fix your initial Else clause to either terminate your script or provide some kind of "default" Files collection.
I have a script that I put together for my users a few years ago for them to log onto to the company drive shares after they had logged into the VPN. The script has worked well over the years with a few tweaks needed here and there due to IE version upgrades. As of today I can no longer get the script to function properly the Error is:
Line: 93
Char: 5
Error: Permission denied: 'objIE.Document.parentWindow.screen'
Code: 800A0046
Source: Microsoft VBScript runtime error
I'm not sure what has changed but after doing multiple searches on the error codes and other items I figured I'd post it here and see if any of you can help me with this problem.
dim WshNetwork
Dim arrFileLines()
'On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("Drive Shares.txt", 1)
If Not err.number = 0 then
WScript.Echo "Drive Shares.txt was not found. Please ensure that it is in the same directory as this script file"
WScript.Quit
End If
NumElements = 0
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(NumElements)
arrFileLines(NumElements) = objFile.ReadLine
NumElements = NumElements + 1
Loop
objFile.Close
strPw = GetPassword()
If strPw = "" Then
wScript.Quit
End If
SplitPasswd = Split(StrPW,"*",2)
username = "DEFAULT\" & SplitPasswd(0)
password = SplitPasswd(1)
Set WshNetwork = Wscript.CreateObject("WScript.Network")
For Count = 0 to (NumElements - 1)
SplitDriveInfo = Split(arrFileLines(Count)," ",2)
DriveLetter = SplitDriveInfo(0)
Share = SplitDriveInfo(1)
ExitCode = WshNetwork.MapNetworkDrive(DriveLetter, Share, false, username, password)
ErrorHandler(err.number)
Next
Sub ErrorHandler(ErrorNumber)
Select Case ErrorNumber
Case 0
'OK
Exit Sub
Case -2147024811
'Already Mapped Continue
Exit Sub
Case -2147024843
'No Connection
WScript.Echo "No connection found. Confirm you have an internet connection and that you have the VPN connected."
WScript.Quit
Case -2147024829
'Share not available
WScript.Echo "The drive share you are trying to connect to does not exist on this server."
WScript.Quit
Case -2147023570
'Invalid username or password
WScript.Echo "Invalid username or password. Please try again."
WScript.quit
Case Else
WScript.Echo "Unknown error: " & CStr(ErrorNumber)
WScript.Quit
End Select
End Sub
Function GetPassword()
Dim objIE
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Navigate "about:blank"
objIE.Document.Title = "Login Credentials"
objIE.ToolBar = False
objIE.Resizable = False
objIE.StatusBar = False
objIE.Width = 320
objIE.Height = 320
With objIE.document.parentWindow.screen
objIE.Left = (.availwidth - objIE.Width ) \ 2
objIE.Top = (.availheight - objIE.Height) \ 2
End With
objIE.Document.Body.InnerHTML = "<DIV align=""center""><P>Please enter your credentials</P>" & vbCrLf _
& "<DIV align=""center""><P>Username</P>" & vbCrLf _
& "<P><INPUT TYPE=""Username"" SIZE=""20"" " _
& "ID=""UserName""></P>" & vbCrLf _
& "<DIV align=""center""><P>Password</P>" & vbCrLf _
& "<P><INPUT TYPE=""password"" SIZE=""20"" " _
& "ID=""Password""></P>" & vbCrLf _
& "<P><INPUT TYPE=""hidden"" ID=""OK"" " _
& "NAME=""OK"" VALUE=""0"">" _
& "<INPUT TYPE=""submit"" VALUE="" OK "" " _
& "OnClick=""VBScript:OK.Value=1""></P></DIV>"
objIE.Visible = True
Do While objIE.Document.All.OK.Value = 0
WScript.Sleep 200
Loop
GetPassword = objIE.Document.All.UserName.Value & "*" & objIE.Document.All.Password.Value
objIE.Quit
Set objIE = Nothing
End Function
Any help with this would be greatly appreciated.
Microsoft released hotfix:[KB3025390] http://support.microsoft.com/kb/3025390
I can confirm uninstalling this update will resolve issue if it worked just prior to December 17th, 2014.
I had a similar problem with an HTA program using IE 11 and the With objIE.Document.ParentWindow.Screen command.
I found adding objIE.left = 910 and objIE.top and removed the With objIE.Document.ParentWindow.Screen section and now the IE Windows opens fine.
Sub AdditionalComputerInfo
'v3.00 - Changed to HTML Output
strComputer = trim(txtComputerName.Value)
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.ToolBar = 0
objIE.StatusBar = 0
objIE.addressbar = 0
objIE.Width = 650
objIE.Height = 900
'added v3.02
objIE.Left = 910
objIE.Top = 20
objIE.Document.Title = " " & uCase(strComputer) & " Information"
'With objIE.Document.ParentWindow.Screen removed in version 3.02
' objIE.Left = 910
' objIE.Top = 20
'End With
Set objDoc = objIE.Document.Body
In the code bellow I get an error on the line reading recset.Close.
Char: 5
Error: Operation is not allowed when the object is closed.
Code: 800A0E78
Source: ADODB.Recordset
If the program reaches the line PQ_ID_number = InputBox("Enter PQ Database ID number, Do not use / ? < > \ : * | !", "PQ ID Number", "Replace Text") it seems to work fine (taking manual input) but when it tries to get the ID from the URL of a browser (automaticaly) it gives the error.
valid_name = 0
Dim objInstances, objIE, counterTab
Do While valid_name = 0 'Flag to exit the loop if the Id number has content in the SQL Database'
'-----------------------------------------------------------------------------------------'
Set objInstances = CreateObject("Shell.Application").windows
If objInstances.Count > 0 Then '/// make sure we have IE instances open.
'Loop through each tab.'
For Each objIE In objInstances
'Split the url of current tab using /'
splitURL = Split(objIE.LocationURL,"/")
'Count how many sub strings are in the URL when split'
counter = UBound(splitURL)
if counter = 7 Then
lastSplit = Split(splitURL(7),".")
lastURL = splitURL(0) & "//" & splitURL(2) & "/" & splitURL(3) & "/" & splitURL(4) & "/" & splitURL(5) & "/" & splitURL(6) & "/" & lastSplit(0)
if lastURL = "URL" Then
Set IE = objIE
counterTab = counterTab + 1
end if
end if
'End if
Next
Else
'If no internet explorer window is open.'
MsgBox "No Internet Explorer window found."
wscript.quit
End if
'Check if no [] is open in internet explorer'
if IsObject(IE) Then
url = Split(IE.LocationURL,"=")
url2 = Split(url(1),"&")
PQ_ID_number = url2(0)
else
MsgBox "No incident found."
wscript.quit
end if
'counterTab counts how many [] are open. If there is more than 1, ask for confirmation of last [] number.'
if counterTab > 1 Then
confirm = msgbox("Please confirm Incident ID: " & incidentID,vbYesNo,"Confirmation")
'If no is pressed, ask for manual entry.'
if confirm = vbNo Then
PQ_ID_number = InputBox("Enter PQ Database ID number, Do not use / ? < > \ : * | !", "PQ ID Number", "Replace Text")
On Error Resume Next
If PQ_ID_number = False Then
wscript.quit
End If
end if
end if
'-----------------------------------------------------------------------------------------'
'Open connection in Database'
dbConnectStr = "connection string"
Set con = CreateObject("ADODB.Connection")
Set recset = CreateObject("ADODB.Recordset")
con.Open dbConnectStr
'Get PQ Database title and status of incident number provided.
SQL_String = "Select title, status_id from incident_TBL where incident_ID = " & PQ_ID_number
recset.Open SQL_String, con
title = recset.Fields(0).Value
incidentStatus = recset.Fields(1).Value
con.Close
recset.Close
If title = False Then 'check if PQ_ID given has content in SQL Database
wscript.echo "Invalid PQ Database ID number, please type correct number"
valid_name = 0
Else
valid_name = 1
End If
Loop
Thanks for the help!
you need close Recordset first and only after that close connection
con.Close
recset.Close
change to:
recset.Close
con.Close