VBScript Add Validation Object runtime error [duplicate] - vbscript

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"

Related

Transferring data between Excel sheets

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.

VBS - Weird Japanese characters conversion

I've been searching Google and StackOverflow and did find some partial answers to my problem. Here is my question:
I've bee n trying to make a small script that will promt the user for keywords and once you hit enter it will parse the array into Chrome or Firefox and open up tabs with all the various searches. It works! But, then I wanted to expand on that so I could make a .txt file and make it read from that, that works too! BUT since it's a Japanese site we're searching, Japanese will yield better results!
So I got the ForReading and TriState/Unicode = -1 to work, and it does issue something in Japanese, the problem is it doesn't issue the characters I inserted into the document. :/ And I'm at a loss at the moment. Here's the part of the code that I need some help with:
'Declaring
Option Explicit
Const ForReading = 1
Const Unicode = -1
Dim FullPath
Dim objShell
Dim SearchArray
Dim Figure
Dim Index
Dim listWord
Dim Mandarake
Dim invalidName
Dim rawImport
Dim objFSO
Dim objTextFile
FullPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(FullPath&"\mandalist.txt", ForReading,True,Unicode)
Set objShell = CreateObject("Shell.Application")
SearchArray = Array()
mandarake = "http://ekizo.mandarake.co.jp/shop/en"
'Starting do loop until we trigger the search with "go"
Do
ReDim Preserve SearchArray(UBound(SearchArray)+1)
Figure = InputBox("Enter a name or type 'go' when you're done!", "Figure search", "List")
SearchArray(UBound(SearchArray)) = "http://ekizo.mandarake.co.jp/shop/en/search.do?action=keyword&doujin=all&keyword="&Replace(Figure," ","+")
'Trying to handle empty or "Name" entry into array error
If Figure = Empty Then
invalidName = MsgBox("Are you sure you want to quit?",1,"Are you sure?")
If invalidName = vbOK Then
WScript.Quit (0)
End If
ElseIf Figure = "List" Then
Do Until objTextFile.AtEndOfStream
rawImport = objTextFile.Readline
Figure = Replace(rawImport," ","+")
SearchArray = Split(Figure , ",")
Call objShell.ShellExecute("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe", mandarake, "", "", 1)
For Index = 0 To UBound(SearchArray)
Call objShell.ShellExecute("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe", "http://ekizo.mandarake.co.jp/shop/en/search.do?action=keyword&doujin=all&keyword="&SearchArray(index), "", "", 1)
WScript.Sleep(1500)
Next
WScript.Quit (0)
Loop
I have more code hence all the dims and set's, but that is if the If Figure = "List" is not true and it will then continue to the insertion of manual keywords, and those works even with Japanese signs. The thing is, no matter what I paste into the text file it will parse other characters (also some Japanese stuff) into the URL instead of what I put in. How can I get it to treat the charset as it's supposed to?
Example would be:
Text in Mandalist.txt = グリフォン アスナ
Text in URL in Chrome = 믯낂菣閃苣뎃ꊂ苣誃 - HMF :s
Any help would be much appreciated.
PS - This is my first project where I don't rely on a piece of paper that my teacher wrote me in school, so it may be simple but I just can't make it work.
Thanks
/CuraeL

Code 800A0005 when using set objFile = objFSO.OpenTextFile

I have searched this error code numerous times and have gone to numerous sites to read responses. Long story short, still haven't found a solution.
One page referenced: Error while sending ( character with sendkeys in vbscript
Here is my code:
set WshShell = WScript.CreateObject("WScript.Shell")
Return = WshShell.Run("C:\Downloads\software\putty.exe -load navstat")
DIM date
date = 301113
DIM tran1
tran1 = TAFFY
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile("C:\Users\Adrian\Desktop\Entries1.txt", ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If InStr(strLine, "JFK.GREKI3.MARTN..TOPPS") Then
set indi = 2
set tran1 = TOPPS
End If
Loop
What's going on: I am scanning a .txt file (Entries1.txt) for text strings. If they occur I need to set corresponding indi values (so when indi is used later as a variable it will use the correct #) and change the tran1 variables as well.
For some reason I'm getting an error at:
set objFile = objFSO.OpenTextFile
The error is
Invalid procedure call or argument
Code: 800A0005
Help would be greatly appreciated.
While Ken's solution is correct, it doesn't properly explain the reason for the error you're getting, so I'm adding a supplementary answer.
The error is caused by the identifier ForReading in the line
set objFile = objFSO.OpenTextFile("C:\Users\Adrian\Desktop\Entries1.txt", ForReading)
The OpenTextFile method accepts an optional second parameter iomode that can have a value of either 1, 2 or 8. However, contrary to what the documentation suggests, there are no pre-defined constants for these numeric values. Unless you define them yourself (which you didn't), e.g. like this:
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
you must use the numeric values or omit the parameter entirely (in which case it defaults to 1).
If you use an undefined identifier like ForReading the interpreter will automatically initialize it with the value Empty, which could produce unexpected behavior as it did in your case.
Demonstration:
>>> WScript.Echo TypeName(ForReading)
Empty
>>> Set f = fso.OpenTextFile("C:\Temp\some.txt", ForReading)
Invalid procedure call or argument (0x5)
>>> WScript.Echo TypeName(f)
Empty
>>> Set f = fso.OpenTextFile("C:\Temp\some.txt", Empty)
Invalid procedure call or argument (0x5)
>>> WScript.Echo TypeName(f)
Empty
>>> 'parameter omitted
>>> Set f = fso.OpenTextFile("C:\Temp\some.txt")
>>> WScript.Echo TypeName(f)
TextStream
>>> Set f = Nothing
>>> 'numeric parameter
>>> Set f = fso.OpenTextFile("C:\Temp\some.txt", 1)
>>> WScript.Echo TypeName(f)
TextStream
>>> Set f = Nothing
>>> 'define identifier before using it as parameter
>>> ForReading = 1
>>> WScript.Echo TypeName(ForReading)
Integer
>>> Set f = fso.OpenTextFile("C:\Temp\some.txt", ForReading)
>>> WScript.Echo TypeName(f)
TextStream
You can avoid this kind of issue by using Option Explicit (which is highly recommended for production code). It will raise a run-time error when there are undefined variables in your code, allowing you to detect problems like this early on.
Removing the ForReading portion of the line allows it to execute on my system using the following code:
'Saved in D:\TempFiles\TypeFile.vbs
set objFSO = CreateObject("Scripting.FileSystemObject")
set objFile = objFSO.OpenTextFile("C:\Users\Ken\Desktop\Test.txt")
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
wscript.echo strLine
Loop
I tested using a simple Test.txt containing the following:
Line 1
Line 2
Line 3
Line 4
Line 5
Line 6
I tested it using the following at a command prompt:
D:\TempFiles>cscript TypeFile.vbs
I received this output:
Note: An additional problem you'll encounter is using set on this line (and perhaps the one that follows it):
set indi = 2
indi is a simple variable, not an object, and therefore there's no need for set. Just assign the value directly:
indi = 2

Delete a file from a given folder N days old

I have written a script that calls for two parameters but every time I run I receive an error message:
Line: 7 Char: 21 Error: Expected Literal constant Code: 800A0415
Can some one please help me understand what I am doing wrong here?
The script below is expecting to receive 2 parameters and execute a file deletion based upon those parameters.
The first parameter will contain the path to the file(s) to be deleted, the second parameter will contain a number representing days old.
Dim arg, var1, var2
set arg = wscript.Arguments
var1 = arg(0)
var2 = arg(1)
Const strPath = var1
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Call Search (strPath)
WScript.Echo"Completed Successfully."
Sub Search(str)
Dim objFolder, objSubFolder, objFile
Set objFolder = objFSO.GetFolder(str)
For Each objFile In objFolder.Files
If objFile.DateLastModified < (Now() - var2) Then
objFile.Delete(True)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Search(objSubFolder.Path)
Next
End Sub
Set objFSO = nothing
Set arg = nothing
Your problem is with the following line:
Const strPath = var1
You cannot set the value of a constant to be a variable. You need to explicitly state a literal thing to be a constant, like:
Const strPath = "C:\Some\Path"
Given what you are trying to do, you would be better off using strPath as a variable and going from there.
Dim strPath : strPath = var1
Or some other similar solution.

Powerpoint automation using vbscript

I am getting error message with the following code:
Dim objPPT As PowerPoint.Application
Dim objPres As PowerPoint.Presentation
'Opening blank presentation
Set objPPT = WScript.CreateObject("PowerPoint.Application")
objPPT.visible = 1
Set objPres = objPPT.presentations.Add
objPres.Slides.Add (1, PowerPoint.PpSlideLayout.ppLayoutBlank)
This Script stops execution prompting error message as Line 1 Char 12 Expected End of statement
I am new to vbscript, Please help if I am making some mistake.
To use vbscript, you must know syntax of vbscript. Below is example code to Add a Slide to PPT (PPT Template used here)
' Add a Slide to a Microsoft PowerPoint Presentation
Const ppLayoutText = 2
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Add
objPresentation.ApplyTemplate _
("C:\Program Files\Microsoft Office\Templates\1033\ProjectStatusReport.potx")
Set objSlide = objPresentation.Slides.Add _
(1, ppLayoutText)

Resources