This code
07: ReDim newArray(0)
08: ReDim oldArray(0)
'populating newArray
40: wscript.echo "redimming oldArray to length of " & UBound(newArray)
41: ReDim oldArray(UBound(newArray))
42: wscript.echo UBound(oldArray)
43: oldArray = newArray
results in the following output:
redimming oldArray to length of 19
19
D:\Scripts\test.vbs(43, 2) Microsoft VBScript runtime error: Type mismatch
How can I make a copy of "newArray()"? (Created via this question)
In VBScript, array assignment copies the right hand side value:
>> Dim a : a = Array(1,2,3)
>> Dim b : b = a
>> b(0) = 17
>> WScript.Echo Join(a), Join(b)
>>
1 2 3 17 2 3
(as opposed to other languages where array assignment often means to make an alias of/a reference to the r-value).
So: don't create an array for the l-value, just Dim the name (to allow Option Explicit).
Attempt II:
If you want a copy of a dynamic array, just assign it to a clean/new variable.
BTW: ReDim newArray(0) - creates an array containing one (empty) element; reflect on the difference between size/Num of Elms vs. UBound/Last Index.
Attempt III:
ReDim a(n) ' create array for/with n+1 elements
... fill a ...
Dim b ' plain variant variable
b = a ' copy a (in)to b
Related
I want to check collection variable contains the key or not in visual basic 6.0
Below is the collection variable I am having
pcolFields As Collection
and I want to check whether it contains the field Event_Code. I am doing this as below but it not worked for me.
If IsMissing(pcolFields("Event_Code")) = False Then
'Do Something
End If
Here is an example solution with try-catch:
Private Function IsMissing(col As Collection, field As String)
On Error GoTo IsMissingError
Dim val As Variant
val = col(field)
IsMissing = False
Exit Function
IsMissingError:
IsMissing = True
End Function
Use it like this:
Private Sub Form_Load()
Dim x As New Collection
x.Add "val1", "key1"
Dim testkey As String
testkey = "key2"
If IsMissing(x, testkey) Then
Debug.Print "Key is Missing"
Else
Debug.Print "Val is " + x(testkey)
End If
Exit Sub
End Sub
You could also try a to Implement or Subclass the Collection and add a "has" Function
Collections are not useful if you need to check for existence, but they're useful for iteration. However, collections are sets of Variants and so are inherently slower than typed variables.
In nearly every case it's more useful (and more optimal) to use a typed array. If you need to have a keyed collection you should use the Dictionary object.
Some examples of general ways of using typed arrays:
Dim my_array() As Long ' Or whichever type you need
Dim my_array_size As Long
Dim index As Long
Dim position As Long
' Add new item (push)
ReDim Preserve my_array(my_array_size)
my_array(my_array_size) = 123456 ' something to add
my_array_size = my_array_size + 1
' Remove item (pop)
my_array_size = my_array_size - 1
If my_array_size > 0 Then
ReDim Preserve my_array(my_array_size - 1)
Else
Erase my_array
End If
' Remove item (any position)
position = 3 'item to remove
For index = position To my_array_size - 2
my_array(index) = my_array(index + 1)
Next
my_array_size = my_array_size - 1
ReDim Preserve my_array(my_array_size - 1)
' Insert item (any position)
ReDim Preserve my_array(my_array_size)
my_array_size = my_array_size + 1
For index = my_array_size - 1 To position + 1 Step -1
my_array(index) = my_array(index - 1)
Next
my_array(position) = 123456 ' something to insert
' Find item
For index = 0 To my_array_size - 1
If my_array(index) = 123456 Then
Exit For
End If
Next
If index < my_array_size Then
'found, position is in index
Else
'not found
End If
Whilst it may seem like a lot code. It is way faster. Intellisense will also work, which is a bonus. The only caveat is if you have very large data sets, then redim starts to get slow and you have to use slightly different techniques.
You can also use a Dictionary, be sure to include the Microsoft Scripting Runtime reference in your project:
Dim dict As New Dictionary
Dim value As Long
dict.Add "somekey", 123456
dict.Remove "somekey"
value = dict.Item("somekey")
If dict.Exists("somekey") Then
' found!
Else
' not found
End If
Dictionaries like collections just hold a bunch of Variants, so can hold objects etc.
We can check following code into vb.net code
If Collection.ContainsKey(KeyString) Then
'write code
End if
Collection is variable of Dictionary and KeyString is a key string which we need to find into collection
The method from efkah will fail if the Collection contains objects rather than primitive types. Here is a small adjustment:
'Test if a key is available in a collection
Public Function HasKey(coll As Collection, strKey As String) As Boolean
On Error GoTo IsMissingError
Dim val As Variant
' val = coll(strKey)
HasKey = IsObject(coll(strKey))
HasKey = True
On Error GoTo 0
Exit Function
IsMissingError:
HasKey = False
On Error GoTo 0
End Function
In a program I am currently making, I need to convert a certain set of characters to numbers. This set of characters is prone to change and also includes CaPiTaL letters in the conversion, of which the capitals will be converted to a different number as with special characters (such as "#", "&", "$", etc). The numbers follow a simple pattern; a = 1, b = 2, c = 3, etc.
The current method I am using to do this is using a separate:
If letter = "a" then
number = 1
End If
This method however is a chore to write up and also seems to be a bit inefficient (in terms of running continuous/bulk amounts of letters through it). Is there any function, sub, etc. that can be used to perform an action like this in VBScript (specifically in VB Express 2010)?
When in doubt, read the documentation. The Asc() function returns the character code of a given ASCII character:
>>> WScript.Echo Asc("a")
97
>>> WScript.Echo Asc("A")
65
Another option is to create a dictionary with the desired mappings:
Set map = CreateObject("Scripting.Dictionary")
map.Add "a", 1
map.Add "b", 2
...
which can be used like this:
>>> WScript.Echo map("a")
1
>>> WScript.Echo map("b")
2
Step 0: Using positional mapping:
Option Explicit
' Start with a function working on a string that calls
' a character decode function
Function decodeS(s)
ReDim aTmp(Len(s) - 1)
Dim i
For i = 0 To UBound(aTmp)
aTmp(i) = decodeC(Mid(s, i + 1, 1))
Next
decodeS = aTmp
End Function
' naive decode via InStr/Index/Position
Function decodeC(c)
decodeC = InStr("abc", c)
End Function
WScript.Echo "acbbca", Join(decodeS("acbbca"))
Step 1: guarded positional mapping:
' guarded decode via InStr/Index/Position
Function decodeC(c)
decodeC = -1
Dim p : p = InStr("abcdefghiA", c)
If p Then decodeC = p
End Function
WScript.Echo "acbbcAx", Join(decodeS("acbbcAx"))
Step 2: positional mapping 'doesn't work', switch to lookup:
' decode via parallel array and InStr/Index/Position
Dim gsC : gsC = "aAbBcC"
Dim gaC : gaC = Split("-1 1 10 2 20 3 30")
Function decodeC(c)
decodeC = CLng(gaC(InStr(gsC, c)))
End Function
WScript.Echo "CcBxbAa", Join(decodeS("CcBxbAa"))
Step 3: you prefer dictionary lookup:
' decode via dictionary
Dim gdC : Set gdC = CreateObject("Scripting.Dictionary")
gdC("a") = 1
gdC("A") = 10
Function decodeC(c)
decodeC = -1
If gdC.Exists(c) Then decodeC = gdC(c)
End Function
WScript.Echo "CcBxbAa", Join(decodeS("CcBxbAa"))
i am trying to execute a vbscript from another vbscript. The think is, i have to pass a dictionary as parameter, but i always get the same error message.
Here is my code so far:
dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
dim dicExp
Set dicExp = CreateObject("Scripting.Dictionary")
dic.add 0, 10
objShell.Run "C:\Users\groeschm\Desktop\ODBCAktuell.vbs " & dicString
But i always get this error message:
Error 800A01C2 - Wrong number of arguments of invalid property assignment.
Greetings,
Michael
You cannot pass an object reference to WScript.Shell.Run. See http://msdn.microsoft.com/en-us/library/d5fk67ky(v=vs.84).aspx, it says the command line argument is a string, and nothing else.
You cannot pass a Scripting.Dictionary reference, nor can you encode that reference into the string argument.
It´s as simple as that!
And even if you could, this would be useless because the called VBS does not share the same global scope as the caller code.
You should consider alternatives to Run. You could put the ODBCAktuell.vbs code into a function, and call that instead. Or you consider ExecuteFile or one of the related intrinsics.
(Without knowing what ODBCAktuell.vbs contains, and without knowing what exactly you are trying to accomplish, it is difficult to advise you further than that.)
There is a similar question based on the same brainbug: Create instance for a class(resides in B.vbs) from another .VBS file
The OT's code is messed up. dicString is undefined. It does not throw the error claimed, but an "Object Required", because the dictionary is named dicExp, not dic.
While TheBlastOne is right to state that you can't pass anything except strings via the command line, the wish to communicate other (more complex) types of data is legitimate. Making numbers or dates from command line args is standard procedure. And: wanting to re-use code via some kind of import/using/include mechanism isn't a brainbug but essential for good programming.
A general approach to serialisation (via strings) is JSON, but it's not easy to use it in VBScript (cf).
The starting point(s) for a 'roll your own' approach for simple cases (dictionaries with numbers/scalars/simple strings as keys and values) is trivial:
Stringify:
cscript passdic.vbs
cscript recdic.vbs "1 2 3 4"
1 => 2
3 => 4
passdic.vbs:
Option Explicit
Function d2s(d)
ReDim a(2 * d.Count - 1)
Dim i : i = 0
Dim k
For Each k In d.Keys()
a(i) = k
i = i + 1
a(i) = d(k)
i = i + 1
Next
d2s = Join(a)
End Function
Function qq(s)
qq = """" & s & """"
End Function
Dim d : Set d = CreateObject("Scripting.Dictionary")
d(1) = 2
d(3) = 4
Dim c : c = "cscript recdic.vbs " & qq(d2s(d))
WScript.Echo c
Dim p : Set p = CreateObject("WScript.Shell").Exec(c)
WScript.Echo p.Stdout.ReadAll()
recdic.vbs:
Option Explicit
Function s2d(s)
Set s2d = CreateObject("Scripting.Dictionary")
Dim a : a = Split(s)
Dim i
For i = 0 To UBound(a) Step 2
s2d.Add a(i), a(i + 1)
Next
End Function
Dim d : Set d = s2d(WScript.Arguments(0))
Dim k
For Each k In d.Keys()
WScript.Echo k, "=>", d(k)
Next
Code re-use:
cscript passdic2.vbs
cscript recdic2.vbs
1 => 2
3 => 4
passdic2.vbs
Option Explicit
Function d2s(d)
ReDim a(d.Count - 1)
Dim i : i = 0
Dim k
For Each k In d.Keys()
a(i) = "cd.Add " & k & "," & d(k)
i = i + 1
Next
d2s = "Function cd():Set cd=CreateObject(""Scripting.Dictionary""):" & Join(a, ":") & ":End Function"
End Function
Dim d : Set d = CreateObject("Scripting.Dictionary")
d(1) = 2
d(3) = 4
CreateObject("Scripting.FileSystemObject").CreateTextFile("thedic.inc").Write d2s(d)
Dim c : c = "cscript recdic2.vbs"
WScript.Echo c
Dim p : Set p = CreateObject("WScript.Shell").Exec(c)
WScript.Echo p.Stdout.ReadAll()
thedic.inc
Function cd():Set cd=CreateObject("Scripting.Dictionary"):cd.Add 1,2:cd.Add 3,4:End Function
recdic2.vbs
Option Explicit
ExecuteGlobal CreateObject("Scripting.FileSystemObject").OpenTextFile("thedic.inc").ReadAll()
Dim d : Set d = cd()
Dim k
For Each k In d.Keys()
WScript.Echo k, "=>", d(k)
Next
I want to load the ascii code of all letters and digits in first n bytes (100000 for example) of a binary file into an array. I wrote this code:
Option Explicit
Dim i, lCharCount, lFileByte, lFileArray(99999)
Dim oFSO, oStream, sInFileName
'Validate input command line
If WScript.Arguments.Count < 1 Then
MsgBox "No input file has been specified!", vbExclamation, "My Script"
WScript.Quit
End If
sInFileName = WScript.Arguments(0)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oStream = oFSO.OpenTextFile(sInFileName, 1)
Do While Not oStream.AtEndOfStream
lFileByte = Asc(oStream.Read(1))
If (lFileByte > 47 And lFileByte < 58) Or (lFileByte > 64 And lFileByte < 91) Or (lFileByte > 96 And lFileByte < 123) Then
lFileArray(lCharCount) = lFileByte
lCharCount = lCharCount + 1
If lCharCount = 100000 Then Exit Do
End If
Loop
oStream.Close: Set oStream = Nothing
But I need it to run faster. I'd rather not use ADODB but, I'm open to all suggestions if it can't be sped up using FSO. Any ideas?
Try something like this:
cnt = 100000
data = oFSO.OpenTextFile(sInFileName).Read(cnt)
ReDim lFileArray(Len(data)-1)
For i = 1 To Len(data)
lFileArray(i-1) = Asc(Mid(data, i, 1))
Next
Try calling ReadAll on your file instead char by char. This will read the entire file and return it as a string. Then use the same loop, but this time on the returned string, using string scan methods.
So I have a number of text files that I'm trying to read with Visual Basic. They all have the same formatting:
[number of items in the file]
item 1
item 2
item 3
...etc.
What I'm trying to do is declare an array of the size of the integer in the first line, and then read each line into corresponding parts of the array (so item 1 would be array[0], item 2 would be array[1], etc. However, I'm not sure where to start on this. Any help would be appreciated.
Pretty basic stuff (no pun intended):
Dim F As Integer
Dim Count As Integer
Dim Items() As String
Dim I As Integer
F = FreeFile(0)
Open "data.txt" For Input As #F
Input #F, Count
ReDim Items(Count - 1)
For I = 0 To Count - 1
Line Input #F, Items(I)
Next
Close #F
try this for VB6
Dim file_id As Integer
Dim strline as string
Dim array_item() as string
'Open file
file_id = FreeFile
Open "C:\list.txt" For Input AS #file_id
Dim irow As Integer
irow = 0
'Loop through the file
Do Until EOF(file_id)
'read a line from a file
Line Input #file_id, strline
'Resize the array according to the line read from file
Redim Preserve array_item(irow)
'put the line into the array
array_item(irow) = strline
'move to the next row
irow = irow + 1
Loop
Close #file_id
The VB function you're looking for is "split":
http://www.vb-helper.com/howto_csv_to_array.html
Try this:
Dim FullText As String, l() As String
'''Open file for reading using Scripting Runtime. But you can use your methods
Dim FSO As Object, TS As Object
Set FSO = createbject("Scripting.FileSystemObject")
Set TS = createbject("Scripting.TextStream")
Set TS = FSO.OpenTextFile(FilePath)
TS.ReadLine 'Skip your first line. It isn't needed now.
'''Reading the contents to FullText and splitting to the array.
FullText = TS.ReadAll
l = Split(FullText, vbNewLine) '''the main trick
Splitting automatically resizes l() and stores all data.
Now the l() array has everything you want.