I have written my code in VBScript.I'm getting error in a particular part of my code shown below.
[ActiveX Script Task] Error: User script threw an exception: Error Code: 0
Error Source= Microsoft VBScript runtime error
Error Description: Object required: 'REGroupSBUOps'
Error on Line 85
'Declaring and connection string statements
strREGroupSBUOps ="sp_CPVarianceOpsReport6"
Set REGroupSBUOps = oDBCon.Execute(strREGroupSBUOps)
Dim arr()
ReDim arr(6)
Dim i
arr(0) = "REGroupSBUOps"
arr(1) = "DandBSBUOps"
arr(2) = "Tristate/Central/EastSBUOps"
arr(3) = "WestSBUOps"
arr(4) = "EastSBUOps"
arr(5) = "UKSBUOps"
If Not (arr(i).EOF) Then ' <--error on this line
'followed by other statements
Put the code inside your For loop into a sub, along with the actual execution of the stored procedures. Pass the stored procedure calls and the names from your array as a parameters to the sub. Replace all occurrences of arr(i) with the name of the variable that takes the records returned by the stored procedure call (rs in my example below).
Sub ExportData(sp, name)
Set rs = oDBCon.Execute(sp)
If Not rs.EOF Then
sFileName1 = "\\CTSC00579895801\ime\MailReports\" & name & ".xls"
Set oFSOExcelFile = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
...
objExcel.Quit
Set objExcel = Nothing
End If
End Sub
ExportData "sp_CPVarianceOpsReport 1" "Tristate_Central_EastSBUOps"
ExportData "sp_CPVarianceOpsReport 2" "UKSBUOps"
...
As further optimization you may want to create the Excel and FileSystemObject objects as global singletons and just handle the files inside the sub instead of creating and destroying those instances over and over again.
Related
This question already has answers here:
Getting an error `xlValues` is not defined when Cells format to the others
(3 answers)
Closed 2 years ago.
I have the following VBScript code.
Dim xlapp ' as excel object
Dim WSx, WSy ' as excel worksheet
Dim x, y ' as workbook
Dim fso
Dim list1
Set xlapp = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullpath
fullpath = fso.GetParentFolderName(WScript.ScriptFullName)
Set x = xlapp.Workbooks.Open(fullPath & "\File1.xlsx")
Set y = xlapp.Workbooks.Open(fullPath & "\File2.xlsm")
Set WSx = x.Worksheets("Sheet1")
Set WSy = y.Worksheets("Sheet1")
WSy.Cells.Clear
WSx.UsedRange.Copy WSy.Range("A1")
Set WSx = nothing
x.Close
WSy.Range("F1").Value="Yes/No"
With WSy.Range("F2").Validation
.Add xlValidateList, xlValidAlertStop, , "Option1,Option2"
.ErrorTitle = "Not a Valid Selection"
.ErrorMessage = "Please make sure you spelled the item correctly or select the item from the dropdowm menu."
.IgnoreBlank = True
.InCellDropdown = True
End With
Set WSy = nothing
y.Save
y.close
xlapp.quit
When executing this code, I get the following error on this line:
.Add xlValidateList, xlValidAlertStop, , "Option1,Option2"
microsoft vbscript runtime error unknown runtime error
Any suggestions on how to resolve this?
You are supplying Excel built-in constants xlValidateList and xlValidAlertStop but you are not in an Excel macro.
VBScript does not support them, you have to use their actual value. Instead of xlValidateList use 3 (see here). It is common to declare them in your script as contants.
Option Explicit
Const xlValidateList = 3
'Const xlValidAlertStop = "didn't look this one up"
This is my script which opens Excel files and takes info from some cells then inserts it in another Excel document. I have included the entire script but marked where I think the error is. I am really confused at why this isn't working as I am using the exact same method in another script that works perfectly.
updated code from answers, same problem remains.
I think it's being caused by the Find_Excel_Row.
I tried putting the script in the function in the loop so there was no problem with variables but I got the same error.
Dim FSO 'File system Object
Dim folderName 'Folder Name
Dim FullPath 'FullPath
Dim TFolder 'Target folder name
Dim TFile 'Target file name
Dim TFileC 'Target file count
Dim oExcel 'The Excel Object
Dim oBook1 'The Excel Spreadsheet object
Dim oBook2
Dim oSheet 'The Excel sheet object
Dim StrXLfile 'Excel file for recording results
Dim bXLReadOnly 'True if the Excel spreadsheet has opened read-only
Dim strSheet1 'The name of the first Excel sheet
Dim r, c 'row, column for spreadsheet
Dim bFilled 'True if Excel cell is not empty
Dim iRow1 'the row with lower number in Excel binary search
Dim iRow2 'the row with higher number in Excel binary search
Dim iNumpasses 'Number of times through the loop in Excel search
Dim Stock 'product stock levels
Dim ID 'product ID
Dim Target 'Target file
Dim Cx 'Counter
Dim Cxx 'Counter 2
Dim RR, WR 'Read and Write Row
Call Init
Sub Init
Set FSO = CreateObject("Scripting.FileSystemObject")
FullPath = FSO.GetAbsolutePathName(folderName)
Set oExcel = CreateObject("Excel.Application")
Target2 = CStr("D:\Extractor\Results\Data.xls")
Set oBook2 = oExcel.Workbooks.Open(Target2)
TFolder = InputBox ("Target folder")
TFile = InputBox ("Target file")
TFileC = InputBox ("Target file count")
Call Read_Write
End Sub
Sub Read_Write
RR = 6
PC = 25
For Cx = 1 to Cint(TFileC)
Target = CStr("D:\Extractor\Results\"& TFolder & "\"& TFile & Cx &".html")
For Cxx = 1 to PC
Call Find_Excel_Row
Set oBook1 = oExcel.Workbooks.Open(Target)
Set Stock = oExcel.Cells(RR,5)
Set ID = oExcel.Cells(RR,3)
MsgBox ( Cxx &"/25 " &" RR: "& RR & " ID: " & ID & " Stock: " & Stock )
oBook1.Close
MsgBox "Writing Table"
oExcel.Cells(r,4).value = Stock '<<< Area of issue
oExcel.Cells(r,2).value = ID '<<<
oBook2.Save
oBook2.Close
Cxx = Cxx + 1
RR = RR + 1
Next
Cx = Cx + 1
Next
MsgBox "End"
oExcel.Quit
End sub
Sub Find_Excel_Row
bfilled = False
iNumPasses = 0
c = 1
iRow1 = 2
iRow2 = 10000
Set oSheet = oBook2.Worksheets.Item("Sheet1")
'binary search between iRow1 and iRow2
Do While (((irow2 - irow1)>3) And (iNumPasses < 16))
'Set current row
r = Round(((iRow1 + iRow2) / 2),0)
'Find out if the current row is blank
If oSheet.Cells(r,c).Value = "" Then
iRow2 = r + 1
Else
iRow1 = r - 1
End If
iNumPasses = iNumPasses + 1
Loop
r = r + 1
'Step search beyond the point found above
While bFilled = False
If oSheet.Cells(r,c).Value = "" Then
bFilled = True
Else
r = r + 1
End If
Wend
oExcel.Workbooks.Close
End Sub
In addition to what #Ekkehard.Horner said, you can't use the Excel object after quitting, so you should be getting an error when trying to open Data.xls.
oExcel.Workbooks.Close
oExcel.Quit
'writes to Graph sheet
set oBook = oExcel.Workbooks.Open("D:\Extractor\Results\Data.xls")
' ^^^^^^ This should be giving you an error
'Writing Table
MsgBox "Writing Table"
oExcel.Cells(r,4).value = Stock <<< Error here
oExcel.Cells(r,2).value = ID <<<
In fact, you're closing the application at several points in your script. Don't do that. Create the Excel instance once, use this one instance throughout your entire script, and terminate it when your script ends.
Edit: This is what causes your issue:
Set Stock = oExcel.Cells(RR,5)
Set ID = oExcel.Cells(RR,3)
...
oBook1.Close
...
oExcel.Cells(r,4).value = Stock '<<< Area of issue
oExcel.Cells(r,2).value = ID '<<<
You assign Range objects (returned by the Cells property) to the variables Stock and ID, but then close the workbook with the data these objects reference.
Since you want to transfer values anyway, assign the value of the respective cells to the variables Stock and ID:
Stock = oExcel.Cells(RR,5).Value
ID = oExcel.Cells(RR,3).Value
Also, I'd recommend to avoid using the Cells property of the application object. Instead use the respective property of the actual worksheet containing the data so it becomes more obvious what you're referring to:
Stock = oBook1.Sheets(1).Cells(RR,5).Value
ID = oBook1.Sheets(1).Cells(RR,5).Value
After you fixed that you'll most likely run into the next issue with the following lines:
oBook2.Save
oBook2.Close
You're closing oBook2 inside a loop without exiting from the loop. That should raise an error in the next iteration (when you try to assign the next values to the already closed workbook). Move the above two statements outside the loop or, better yet, move them to the Init procedure (after the Call Read_Write statement). From a handling perspective it's best to close/discard objects in the same context in which they were created (if possible). Helps avoiding attempts to use objects before they were created or after they were destroyed.
To further optimize your script you could even avoid the intermediate variables Stock and ID and transfer the values directly:
oBook2.Sheets(1).Cells(r,4).value = oBook1.Sheets(1).Cells(RR,5).Value
oBook2.Sheets(1).Cells(r,2).value = oBook1.Sheets(1).Cells(RR,5).Value
Re-using the same loop control variable (count) in nested loops is illegal:
Option Explicit
Dim bad_loop_counter
For bad_loop_counter = 1 To 2
WScript.Echo "outer", bad_loop_counter
For bad_loop_counter = 1 To 2
WScript.Echo "inner", bad_loop_counter
Next
Next
output:
cscript 32246593.vbs
... 32246593.vbs(6, 26) Microsoft VBScript compilation error: Invalid 'for' loop control variable
So your code won't even compile.
I am trying to create a VbScript file that will read a text file that has a list of folder names in it.
From these folder names I need to create a second text file that prints out all the files with a specific extension.
I have used this code to do the second part of the task
Option Explicit 'force all variables to be declared
Const ForWriting = 2
Dim objFSO 'File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objTS 'Text Stream Object
Set objTS = objFSO.OpenTextFile("C:\Output.txt", ForWriting, True)
Call Recurse("C:\")
objTS.Close()
Sub Recurse(strFolderPath)
Dim objFolder
Set objFolder = objFSO.GetFolder(strFolderPath)
Dim objFile
Dim objSubFolder
For Each objFile In objFolder.Files
'only proceed if there is an extension on the file.
If (InStr(objFile.Name, ".") > 0) Then
'If the file's extension is "pfx", write the path to the output file.
If (LCase(Mid(objFile.Name, InStrRev(objFile.Name, "."))) = ".exe") Then _
objTS.WriteLine(objfile.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call Recurse(objSubFolder.Path)
Next
End Sub
I have tried to put this in a loop but when I do I get a syntax error for this line Sub Recurse(strFolderPath)
Any help you can give me would be appreciated
One interpretation of
I have tried to put this in a loop but when I do I get a syntax error
for this line Sub Recurse(strFolderPath)
is that the structure of your resulting script looks like:
Do Until tsIn.AtEndOfStream
p = tsIn.ReadLine
Sub Recurse(p)
End Sub
Call Recurse(p)
Loop
output:
cscript 27537600-B.vbs
..\27537600-B.vbs(3, 4) Microsoft VBScript compilation error: Syntax error
VBScript does not allow nested Sub/Function definitions, especially in loops (you may get away with mixing simple statements and Sub/Function definitions in top-level code, but that's more a bug than a feature). If you re-structure the script like
Do Until tsIn.AtEndOfStream
p = tsIn.ReadLine
Call Recurse(p)
Loop
Sub Recurse(p)
End Sub
you won't get a syntax error on the Sub line.
I have created a vbs example to illustrate my problem.
In the development environment in which I work I have no 'each' construction available. Therefore I have to work with 'item'-iteration.
ShowFolderList1 works fine but ShowFolderList2 generates the error.
Can you help me to correct syntax?
ShowFolderList1("C:\Windows") shows me the list of folders in the specified directory.
ShowFolderList2("C:\Windows") gives errorcode 800A0005 Runtimeerror invalid Procedure Call at "F1 = FOL.SubFolders.Item(i)".
Sub ShowFolderList1(folderspec)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FOL = FSO.GetFolder(folderspec)
s = ""
For Each F1 in FOL.SubFolders
s = s & F1.Name & vbCrLf
Next
MsgBox(s)
End Sub
Sub ShowFolderList2(folderspec)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FOL = FSO.GetFolder(folderspec)
s = ""
For i = 0 To FOL.SubFolders.Count-1
F1 = FOL.SubFolders.Item(i)
s = s & F1.Name & vbCrLf
Next
MsgBox(s)
End Sub
As F1 shall hold an object,
F1 = FOL.SubFolders.Item(i)
should be
Set F1 = FOL.SubFolders.Item(i)
On second thought:
The real reason for the error is: the folder object has no Item method. You can't traverse folders randomly, only via For Each.
I am having an odd issue where I am trying to pass three recordsets to a method to have them filled with data all under the same database connection. By reviewing the custom logging info when running the code below I can see that I am getting a Type Mismatch error when assigning the recordsets passed to the method to the local variables within the method.
So the following gets logged when the mthod is called:
7/15/2010 10:59:47 AM - Begin GetALLRecordSets
7/15/2010 10:59:47 AM - Begin GetALLRecordSets RS initialization
The odd bit is that this same code works on our beta server where the asp code is identical and the component dll is identical.
Any thoughts on what may be causing this issue?
Classic ASP code:
set rs1= createobject("ADODB.Recordset")
set rs2 =createobject("ADODB.Recordset")
set rs3 = createobject("ADODB.Recordset")
set myObj = Server.CreateObject("Component.className")
call myObj.GetAllRecordSets(rs1, rs2, rs3)
VB6 Component Code:
Public Sub GetALLRecordSets(ByRef rs1 As Variant, _
ByRef rs2 As Variant, _
ByRef rs3 As Variant)
On Error GoTo ErrorSpot
WriteToLog "Begin GetALLRecordSets", "", 0, ""
Dim lngErrNum As Long
Dim strErrDesc As String
Dim filterStr As String
Dim objConn As ADODB.Connection
Dim myrs1 As ADODB.Recordset
Dim myrs2 As ADODB.Recordset
Dim myrs3 As ADODB.Recordset
WriteToLog "Begin GetALLRecordSets RS initialization", "", 0, ""
Set myrs1 = rs1
Set myrs2 = rs2
Set myrs3 = rs3
WriteToLog "End GetALLRecordSets RS initialization", "", 0, ""
Set rs1 = myrs1.Clone
Set rs2 = myrs2.Clone
Set rs3 = myrs3.Clone
ExitSpot:
'Cleanup
Exit Sub
ErrorSpot:
'Save the error information
lngErrNum = Err.Number
strErrDesc = Err.Description
'Log the error
WriteToLog "GetALLRecordSets", strErrDesc, lngErrNum, strErrDesc
End Sub
Different version of MDAC on server? You may need to create a specific version of Recordset e.g.
Set rs1 = CreateObject("ADODB.Recordset.2.8")