I am using the following For loop to display all files in a folder excluding files with an .asp extension.
I want to add the filename to an array, so that objFileItem.Name gets added to each element in tmpArray.
I tried using tmpArray(k) = objFileItem.Name but its throwing an error.
For Each objFileItem In objFolderContents
strFileExtension = LCase(Mid(objFileItem.Name, _
InStrRev(objFileItem.Name, ".", -1, 1) + 1))
If strFileExtension <> "asp" Then
strImages=strImages & objFileItem.Name
end if
Next
If you have reasonable amount of items (less than 100) just use dynamic array like this:
Dim tmpArray()
ReDim tmpArray(-1)
For Each objFileItem In objFolderContents
strFileExtension = LCase(Mid(objFileItem.Name, _
InStrRev(objFileItem.Name, ".", -1, 1) + 1))
If strFileExtension <> "asp" Then
strImages = strImages & objFileItem.Name
ReDim Preserve tmpArray(UBound(tmpArray) + 1)
tmpArray(UBound(tmpArray)) = objFileItem.Name
End If
Next
'show array items:
Response.Write("Total of " & (UBound(tmpArray) + 1) & " files:<br />")
For k=0 To UBound(tmpArray)
Response.Write(tmpArray(k) & "<br />")
Next
'when done with the array, release resources to prevent memory leak:
Erase tmpArray
Related
Perspective: This script will run on user login and on command with a shortcut on the desktop. The order the application start is imperative. Throughout the script, I require the full path and the program name.
Problem: Each program path is a value in an array. I am trying to split each program path by “\” and get the upper bound to get the program name. Then Redim Preserve the original array and add the program on the second dimension. After reading for many hours, I grasp I can only change the last dimension, but I can’t figure out how to not get out of bound errors. This Creating a Multidimensional, Associative Array in VBScript is not trying to redim preserve from a For Each split.
Set objFso = CreateObject("Scripting.FileSystemObject")
'---Create Program Variables
strProgram1 = "%SystemRoot%\notepad.exe"
strProgram2 = "C:\Program Files\Microsoft Office\root\Office16\OUTLOOK.EXE"
strProgram3 = "C:\Program Files\Microsoft Office\root\Office16\ONENOTE.EXE"
strProgram4 = "C:\Program Files (x86)\Internet Explorer\iexplore.exe" & " https://www.google.com" 'IE with URL
'---Add Program Path Variables to an Array
ReDim strProgramList(3)
strProgramList = Array(strProgram1,strProgram2,strProgram3,strProgram4)
strProgramNameList = Array()
strProgramRestartList = Array()
boolNeedsRestart = false
'---Iterating using For each loop to get program name.
ReDim Preserve strProgramList(3, 1)
For Each strProgramPath In strProgramList
strPathComponents = Split(strProgramPath, "\")
strProgramName = strPathComponents(Ubound(strPathComponents))
strProgramList(0, LBound(strProgramList) + 1) = strProgramName
Next
MsgBox strProgramList(0,0) & vbNewLine & strProgramList(1,0) & vbNewLine & strProgramList(2,0) & vbNewLine & strProgramList(3,0) & vbNewLine & strProgramList(0,1) & vbNewLine & strProgramList(1,1) & vbNewLine & strProgramList(2,1) & vbNewLine & strProgramList(3,1)
How to use the FileSystemObject to parse/build pathes and how to work with two-dimensional arrays:
Option Explicit
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim a : a = Split("A:\B\CC.EXE A:\CC\DD.CMD C:\You\Got\It.pl")
ReDim b(2, UBound(a))
Dim i
For i = 0 To UBound(a)
b(0, i) = a(i)
b(1, i) = goFS.GetParentFolderName(a(i))
b(2, i) = goFS.GetFileName(a(i))
Next
ReDim Preserve b(2, UBound(b, 2) + 1)
b(0, UBound(b, 2)) = "P:\i\pa\po.py"
b(1, UBound(b, 2)) = goFS.GetParentFolderName(b(0, UBound(b, 2)))
b(2, UBound(b, 2)) = goFS.GetFileName(b(0, UBound(b, 2)))
For i = 0 To UBound(b, 2)
WScript.Echo b(0, i), "=", b(1, i), "+", b(2, i), "=>", goFS.BuildPath(b(1, i), b(2, i))
Next
output:
cscript twodim.vbs
A:\B\CC.EXE = A:\B + CC.EXE => A:\B\CC.EXE
A:\CC\DD.CMD = A:\CC + DD.CMD => A:\CC\DD.CMD
C:\You\Got\It.pl = C:\You\Got + It.pl => C:\You\Got\It.pl
P:\i\pa\po.py = P:\i\pa + po.py => P:\i\pa\po.py
<%
dim narrationCounter,logDateString,logDate, logTime,folderName,folderPath,logFolder2,month,day,year,txtFilePath
logDateString = Request.Form("logDateString")
logDate = Date()
folderName = "NarrationClickLog" & "_" & logDate
month = DatePart("m",Now())
day = DatePart("d", Now())
year = DatePart("yyyy",Now())
folderPath = "D:\iisroot\casecomments\CaseNarrationClickLog" + "_" & month & "_" & day & "_" & year
txtFilePath = folderPath + "\CaseNarrationClickLog.txt"
visitorIP=Request.ServerVariables("REMOTE_ADDR")
visitorUserName = Request.ServerVariables("REMOTE_USER")
visitorHost = Request.ServerVariables("remote_host")
set oFs = server.createobject("Scripting.FileSystemObject")
If Not oFs.FolderExists(folderPath) Then
set logFolder=oFs.CreateFolder(folderPath)
End If
' Extract last updated narration button click value from text file
if oFs.FileExists(txtFilePath) then
if oFs.GetFile(txtFilePath).size <> 0 then 'Get narrationCounterVal from log file
' open the file and Read it
set oTextFile = oFs.OpenTextFile(txtFilePath, 1 , true) 'forreading
ReadMe = oTextFile.ReadAll
Tab = split(ReadMe,vbcrlf)
i = ubound(Tab) - 2
paragraph=paragraph & Tab(i) & ""
Response.Write("Paragraph is : " + paragraph)
paragraphReverse = StrReverse(paragraph)
Response.Write( paragraphReverse )
' get the narration counter
narrationCounterPos = Split(paragraphReverse)
'Default delimiter is the space character..in this case Split at the Space before colon SO first element in array is narration counter number
narrationCounterVal = StrReverse(narrationCounterPos(0))
'Response.Write("Latest Narration Counter from text file is :- " + narrationCounterVal)
narrationCounter = narrationCounterVal + 1
oTextFile.Close
set oTextFile = nothing
WriteToLogFile(narrationCounter)
else ' Set narration Counter Value = 1 , A NEW FIRST Record entry.
narrationCounter = 1
WriteToLogFile(narrationCounter)
end if
Response.Write("Latest Narration Counter value :- " + narrationCounterVal)
Response.Write("file exists")
else
Response.Write("File does not exist")
end if
function WriteToLogFile(narrationCounter)
set oTextFileWrite = oFs.OpenTextFile(txtFilePath, 8, True) ' "D:\IISROOT\CaseComments\CaseNarrationClickLog.txt"
oTextFileWrite.WriteLine " User IP Address: " + visitorIP + " User Name: " + visitorUserName + " Clicks on DATE : " + logDateString + " are : " + narrationCounter
Response.Write("Text file path : -" + txtFilePath & " visitor IP : " & visitorIP & " User name: " & visitorUserName & " visitor host: " & visitorHost)
oTextFileWrite.Close
set oTextFileWrite = nothing
end function
oTextFile.Close
set oTextFile = nothing
oTextFileWrite.Close
set oTextFileWrite = nothing
set oFS = nothing
%>
This code must do the following:
Checks if folder exists, if not, create
Check if text file exists, If Yes then Read contents from text file in the above way, extract the narrationCounterVal variable value and then WRITE to the text file using the WritetoLogFile(narrationCounter) function
Problem: Just stuck. The folder and file get created BUT nothing gets written to it. I am also making sure that I close the oTextFile object used for opening file in Read mode before I call the Writetologfile function.
Is there any way to list available methods for created object in VBS?
For example:
Set IE = CreateObject("InternetExplorer.Application")
I want to list available properties of this object, as:
IE.AddressBar
IE.Application
IE.Busy
...
or methods:
IE.ClientToWindow
IE.ExecWB
IE.GetProperty
...
How can I discover available properties to arbitrary valid object in VBS?
Using TypeLib Information Objects from tlbinf32.dll it is possible to list all members of a class.
`tlbinf32.dll` was part of *Visual Studio 6.0*, which was the current release in the years around 2000. Microsoft seems to not offer the DLL for download anymore (situation mid 2017), but you can download it from various sites on the internet. I found version *1.1.88.4, Build 8804, Copyright Matthew Curland 1996, Microsoft 1997-2000, size 148.480 Bytes* at https://www.dll4free.com/tlbinf32.dll.html, or other sites.
To install the DLL in Win32, copy it to `%windir%\System32` and *as administrator* call `regsvr32.exe tlbinf32.dll` from that directory.
To insttall the DLL in Win64, copy it to `%windir%\syswow64`, then *as administrator* register with `%windir%\syswow64\regsvr32.exe`, and finally run the vbscript with `%windir%\syswow64\cscript.exe` (or `wscript.exe`). Thanks [BuvinJ](/users/3220983/buvinj) for the [hint](/questions/14305750/list-object-methods-and-properties/44459670?noredirect=1#comment86169321_44459670)
The following script demonstrates the included function VariableInfo which will return a string with the type of the passed variable, and in case of an Object, all members with details, including type of Property, callable type (Sub or Function), and parameter names and return type in case of Function. The type name of the object in case of a COM object would be the name of the implemented Interface. Not sure if it works for multiple implemented interfaces, but AFAIK it's not possible to implement multiple interfaces in one class via COM anyway.
It does not support recursion in any way, because this would lead to infinity loops for some types.
This will give you virtually full working reflection in VBS. Great to explore APIs for example with the Microsoft Script Debugger.
' Reflection for VBScript via tlbinfo32.dll
'
' Patrick Strasser-Mikhail 2017-2021
' Ansgar Wiechers 2019
' https://stackoverflow.com/questions/14305750/list-object-methods-and-properties/44459670#44459670
'
' v1.1 2021-02-01: Show values of arrays and objects, but only one level
' Returns a String describing the passed object/variable on the first level,
' no recursion.
Function VariableInfo(obj)
VariableInfo = VariableInfoToLevel(obj, 0, 1)
End Function
' Returns a String describing the passed object/variable on the first level,
' recurse down to level max_level(0=no recursion).
Function VariableInfoToLevel(obj, level, max_level)
Const invokeKindPropertyGet = 0 ' simple data member
Const invokeKindFunction = 1 ' method: Sub or Function
Const invokeKindPropertyPut = 2 ' Docs: has a value setter; reality: more like is settable
Const invokeKindPropertyPutRef = 4 ' Docs: has a reference setter; reality: more like is not settable
If level > max_level Then
VariableInfoToLevel = ""
Exit Function
End If
Dim indent : indent = Space(4 * level)
VariableInfoToLevel = indent
If isEmpty(obj) Or _
isNull(obj) _
Then
VariableInfoToLevel = VariableInfoToLevel & TypeNameFromVarType(VarType(obj))
ElseIf Not IsObject(obj) Then
If Not isArray(obj) Then
VariableInfoToLevel = indent & TypeNameFromVarType(VarType(obj)) & ", Value: [" & obj & "]"
Else
VariableInfoToLevel = indent & TypeNameFromVarType(VarType(obj))
Dim dimension
ReDim sizes(0)
Dim size
On Error Resume Next
Err.Clear
For dimension = 0 To 10 ' deliberate limit to prevent infinite loop
size = Ubound(obj, dimension + 1)
If Err.Number <> 0 Then
' report ther then Index out of Bounds
If Err.Number <> 9 Then
WScript.Echo "Exception " & Err.Number & ": " & Err.Description & "; in " & Err.Source
End If
Exit For
End If
ReDim Preserve sizes(dimension)
sizes(dimension) = size
Next
On Error Goto 0
VariableInfoToLevel = VariableInfoToLevel & "(" & Join(sizes, ",") & ")"
Select Case dimension
Case 1
VariableInfoToLevel = VariableInfoToLevel & " {" & vbCrlf
Dim idx
For idx = LBound(obj) To UBound(obj)
VariableInfoToLevel = VariableInfoToLevel & indent & _
" " & idx & ":" & _
Trim(VariableInfoToLevel(obj(idx), level + 1, max_level)) & vbCrlf
Next
VariableInfoToLevel = VariableInfoToLevel & indent & "}" & vbCrlf
Case 2
VariableInfoToLevel = indent & "{" & vbCrlf
Dim idx1, idx2
For idx1 = LBound(obj, 1) To UBound(obj, 1)
For idx2 = LBound(obj, 2) To UBound(obj, 2)
VariableInfoToLevel = VariableInfoToLevel & indent & _
" " & idx1 & "," & idx2 & ":" & _
Trim(VariableInfoToLevel(obj(idx1, idx2), level + 1, max_level)) & vbCrlf
Next
Next
VariableInfoToLevel = VariableInfoToLevel & indent & " }" & vbCrlf
Case Else
' 0 is empty anyway, more is too complicated to print, just leave it for now
End Select
End If
ElseIf TypeName(obj) = "Nothing" Then
VariableInfoToLevel = indent & "Nothing (The Invalid Object)"
Else
' Object
VariableInfoToLevel = indent & "Object " & TypeName(obj)
'' Need to think about that... True for Err, but not for System.Dictionary
'' Seems Err is very special, and we should compare explicitly with internal/predifined Objects (Err, WScript)
'If varType(obj) <> vbObject Then
' hm, interresting...
' VariableInfoToLevel = VariableInfoToLevel & " with default property (no analysis possible)"
' Exit Function
'End If
Dim TLI
Dim MemberInfo
Dim TypeInfo
Set TLI = CreateObject("TLI.TLIApplication")
VariableInfoToLevel = indent & "Object " & TypeName(obj)
On Error Resume Next
Err.Clear
Set TypeInfo = TLI.InterfaceInfoFromObject(obj)
If Err.Number <> 0 Then
VariableInfoToLevel = VariableInfoToLevel & "; Error " & Err.Number
VariableInfoToLevel = VariableInfoToLevel & ": " & Err.Description
Err.Clear
On Error Goto 0
Exit Function
End If
On Error Goto 0
For Each MemberInfo In TypeInfo.Members
Dim Desc
Dim printNextLevel : printNextLevel = vbFalse
Desc = ""
' based on .Net System.Runtime.IteropService.ComTypes
'' FIXME: Call by Value/Reference and settable seems to be switched some
'' InvokeKind seems to not encode value passing, rather settable/not settable
'' Needs more work to decode byValue/byReference
Select Case MemberInfo.InvokeKind
Case InvokeKindFunction
If MemberInfo.ReturnType.VarType <> 24 Then
Desc = " Function " & TypeNameFromVarType(MemberInfo.ReturnType.VarType)
Else
Desc = " Sub"
End If
Desc = Desc & " " & MemberInfo.Name
Dim ParameterList
ParameterList = Array()
Dim Parameter
For Each Parameter In MemberInfo.Parameters
ReDim Preserve parameterList(UBound(ParameterList) + 1)
ParameterList(Ubound(parameterList)) = Parameter.Name
Next
Desc = Desc & "(" & Join(ParameterList, ", ") & ")"
'Set parameters = Nothing
Case InvokeKindPropertyGet
Desc = " Data Member " & MemberInfo.Name
printNextLevel = vbTrue
Case InvokeKindPropertyPut
' Seems to be
Desc = " Property " & MemberInfo.Name & " [set by val"
If IsGettable(obj, MemberInfo.Name) Then
Desc = Desc & "/get"
printNextLevel = vbTrue
End If
Desc = Desc & "]"
'Stop
Case InvokeKindPropertyPutRef
'Stop
Desc = " Property " & MemberInfo.Name & " [set by ref"
If IsGettable(obj, MemberInfo.Name) Then
Desc = Desc & "/get"
printNextLevel = vbTrue
End If
Desc = Desc & "]"
'Stop
Case Else
Desc = " Unknown member, InvokeKind " & MemberInfo.InvokeKind
End Select
VariableInfoToLevel = VariableInfoToLevel & vbNewLine & _
indent & Desc
If printNextLevel And level < max_level Then
VariableInfoToLevel = VariableInfoToLevel & vbNewLine & _
VariableInfoToLevel(eval("obj." & MemberInfo.Name), level + 1, max_level)
End If
Next
Set TypeInfo = Nothing
Set TLI = Nothing
End If
End Function
Function IsGettable(obj, memberName)
Dim value
On Error Resume Next
Err.Clear
value = eval("obj." & memberName)
Stop
If Err.Number <> 0 And _
Err.Number <> 438 And _
Err.Number <> 450 Then
WScript.Echo Err.Number & ": " & Err.Description
End If
'438: Object doesn't support this property or method
'450: Wrong number of arguments or invalid property assignment
If Err.Number = 438 Or _
Err.Number = 450 Then
IsGettable = vbFalse
Else
IsGettable = vbTrue
End If
End Function
Function IsSimpleType(obj)
If (isEmpty(obj) Or isNull(obj)) And (Not IsObject(obj)) And (Not isArray(obj)) Then
IsSimpleType = vbTrue
Else
IsSimpleType = vbFalse
End If
End Function
' Decode Type Number to something readable
Function TypeNameFromVarType(typeNr)
Dim typeDetails
set typeDetails = CreateObject("Scripting.Dictionary")
typeDetails.add 0, "vbEmpty (uninitialized variable)"
typeDetails.add 1, "vbNull (value unknown)"
typeDetails.add 2, "vbInteger" ' Short?
typeDetails.add 3, "vbLong" ' Integer?
typeDetails.add 4, "vbSingle"
typeDetails.add 5, "vbDouble"
typeDetails.add 6, "vbCurrency"
typeDetails.add 7, "vbDate"
typeDetails.add 8, "vbString"
typeDetails.add 9, "vbObject"
typeDetails.add 10, "Exception"
typeDetails.add 11, "vbBoolean"
typeDetails.add 12, "vbVariant"
typeDetails.add 13, "DataObject"
typeDetails.add 14, "vbDecimal"
typeDetails.add 17, "vbByte"
typeDetails.add 18, "vbChar"
typeDetails.add 19, "ULong"
typeDetails.add 20, "Long" ' realy Long?
typeDetails.add 24, "(void)"
typeDetails.add 36, "UserDefinedType"
If typeDetails.Exists(typeNr) Then
TypeNameFromVarType = typeDetails(typeNr)
ElseIf typeNr > 8192 Then
TypeNameFromVarType = "vbArray{" & TypeNameFromVarType(typeNr - 8192) & "}"
Else
typeNameFromVarType = "Unknown Type " & typeNr
End If
End Function
' Some nice example class to demonstrate all possible interfaces.
Class MyClass
Dim Name_
Dim Name2_
Dim Name3_
Dim Name4_
Dim dict
Private Sub Class_Initialize()
Name_ = "foo"
Name2_ = "bar"
Name3_ = "baz"
Name4_ = "spam"
Set dict = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set dict = Nothing
End Sub
Public Property Get Name
Name = Name_
End Property
Public Property Let Name(ByVal Value)
Name_ = Value
End Property
Public Property Let Name2(ByRef Value)
Set Name2_ = Value
End Property
Public Property Get Name3
Name3 = Name3_
End Property
Public Property Set Name3(ByVal Value)
Set Name3_ = Value
End Property
Public Property Get Name4
Name4 = Name4_
End Property
Public Property Set Name4(ByRef Value)
Set Name4_ = Value
End Property
Sub TestSub()
WScript.Echo "Test"
End Sub
Sub TestFunc(message)
WScript.Echo "Test: " & message
End Sub
Sub TestFunc2(ByRef message)
WScript.Echo "Test: " & message
End Sub
Function Add(first, second)
Add = first + second
End Function
Function Substract(ByVal first, ByRef second)
Add = first - second
End Function
End Class
Sub testVariableInfo()
Dim variable
' vbEmpty
Wscript.Echo VariableInfo(variable)
variable = Null
Wscript.Echo VariableInfo(variable)
Set variable = Nothing
Wscript.Echo VariableInfo(variable)
Wscript.Echo VariableInfo(Int(23))
Wscript.Echo VariableInfo(cLng(23))
Wscript.Echo VariableInfo(2147483647)
Wscript.Echo VariableInfo(5/4)
Wscript.Echo VariableInfo(4 * Atn(1)) ' Simplest way to pi, not all inverse functions like arcsin are defined.
Wscript.Echo VariableInfo(3.4E38)
Wscript.Echo VariableInfo(CDbl(3.4E38))
Wscript.Echo VariableInfo(cCur(20.123456))
Wscript.Echo VariableInfo(now)
Wscript.Echo VariableInfo("Some Text")
Wscript.Echo VariableInfo(Err)
Dim MyObject
Set MyObject = new MyClass
Wscript.Echo VariableInfo(MyObject)
Set MyObject = Nothing
Dim TestAEmpty()
Wscript.Echo VariableInfo(TestAEmpty)
ReDim TestA1(17)
Wscript.Echo VariableInfo(TestA1)
Dim TestA2(3, 7)
Wscript.Echo VariableInfo(TestA2)
Dim TestA3
TestA3 = Array(4, 5, 6)
Wscript.Echo VariableInfo(TestA3)
Dim dict
Set dict = CreateObject("Scripting.Dictionary")
WScript.Echo VariableInfo(dict)
Set dict = Nothing
End Sub
testVariableInfo
For for more information about the Typelib Interface, get the documentation help file from Microsoft KB artivle 224331
Matthew Curland offers for download at the website to his book Advanced Visual Basic 6 the nice program Type Library Editor (EditTLBEval.exe) as evaluation version, and the according Documentation
Especially in this context I really like the line If you're a Visual Basic developer who refuses to recognize the commonly accepted limitations of VB, this book is definitely for you. by Ted Pattison. Just replace VB by VBScript here.
VBWebProfi gave the hint for TLI, thanks for that. Working out the details and writing the code was several hours of work, though ;-)
VBScript itself does not support type introspection outside the TypeName and VarType functions, which will give you the type of an object, but won't give you access to its internal structure.
As other answers explained there is a DLL that would provide this feature, but it doesn't ship with Windows, and since it was part of an old version of Visual Studio there might not be a legal way to obtain it nowadays.
While that is partially true, its incomplete.... Google, GetObjectText_, Methods_, & Propeties_
The referenced methods will only work on objects collected while connected to the cimv2 namespace of a remote host via the WbemScripting.SWbemLocator object. If this object has the ability to work on localhost, it's unapparent to me.
Once you do this you can query any of the classes held therein [Win32_Services,Win32_Drives, etc] and interrogate the objects in the resultset using a For-Next loop on the object like below...
For Each oProp in oObject.Properties_
'be careful here because some propeties may be an object or an array.
'so test for that here using "typename" or "vartype"
wScript.Echo oProp.Name & vbTab & oProp
Next
Or...
For Each oMethod in oObject.Methods_
wScript.Echo oProp.Name
Next
Finally, ...
For Each oProp in oObject.Properties_
'This will display all of an objects properties
oProp.GetObjectText_
Next
If you happen to be using HP UFT or QTP then follow these steps:
1) Install any version of MS Visual Studio onto your laptop. (Don't worry about licensing, you won't be running VS)
2) Reboot your computer.
3) Launch UFT or QTP, load a script and hit F11, (or pause at any piece of code that is near the object you want to inspect).
4) Add the object to the Watch window. It can be an Object Repository object or a programmatic description.
If the object exists, the object will now display two Plus (+) signs in the Watch window that can be expanded to show all available Methods and Properties, as well as child objects that can be expanded.
Use TLI . The TLI.TLIApplication class (from tlbinf32.dll) can inspect various COM objects from their instance. Explore the TLI library in Excel or other Microsoft product that supports scripting and has an script editor which is able to add references, then add tlbinf32.dll. The name in the references is "Typelib information".
Note that the DLL does not ship with Windows, though.
Use the method InterfaceInfoFromObject() for VBScript classes and alternatively try ClassInfoFromObject().
Option Explicit
Dim TLI
Dim MyObject
Dim TypeInfo
Dim MemberInfo
Set TLI = CreateObject("TLI.TLIApplication")
Set MyObject = New MyClass
Set TypeInfo = TLI.InterfaceInfoFromObject(MyObject)
For Each MemberInfo In TypeInfo.Members
WScript.Echo MemberInfo.Name
Next
Class MyClass
Dim Name_
Public Property Get Name
Name = Name_
End Property
Public Property Let Name(ByVal Value)
Name_ = Value
End Property
End Class
Try this ...
For i = 0 To webElementCount-1 Step 1
innertextProp = myValue2(i).GetROProperty("innertext")
print i & innertextProp
print innertextProp
Next
I think my code successfully creates the multi dimensional array because I get the right amount when I count it with UBound(DataArray).
But I get null value when I try to display one of the data as Response.Write DataArray(1,0).
Any help appreciated!
sDateArray = Split(DateArray, ",")
sVenueArray = Split(VenueArray, ",")
Dim DataArray()
For i = 0 to uBound(sDateArray)-1
ReDim DataArray(i, 1)
DataArray(i, 0) = sDateArray(i)
DataArray(i, 1) = sVenueArray(i)
Next
Response.Write UBound(DataArray) & "<br /><br />"
DataArray(1,0)
Response.Write DataArray(1,0)
Try Redim Preserve DataArray(i, 1) instead of ReDim DataArray(i, 1)
...or...
sDateArray = Split(DateArray, ",")
sVenueArray = Split(VenueArray, ",")
Dim DataArray(uBound(sDateArray)-1, 1)
For i = 0 to uBound(sDateArray)-1
DataArray(i, 0) = sDateArray(i)
DataArray(i, 1) = sVenueArray(i)
Next
Response.Write UBound(DataArray) & "<br /><br />"
' DataArray(1,0) ' <== commented out cos I think this might be an error - ?
Response.Write DataArray(1,0)
Ok I was bored so I wrote this.
May not be perfect - it's been a while since I used Classic ASP
Function SortByDate(a_input)
x = UBound(a_input, 1) - 1
if( x < 1 ) Then
Response.Write "<p>Invalid input array - first element is empty</p>"
Stop
End If
Dim a_output(x, 1)
Dim earliest_date
For j=0 To x
earliest_date = -1
For i=0 To UBound(a_input, 1) - 1
If a_input(0, i) <> "" Then
If earliest_date = -1 Then
earliest_date = i
Else
If CDate(a_input(0,i)) > CDate(a_input(0,earliest_date)) Then
earliest_date = i
End If
End If
End If
Next
a_output(0, i) = a_input(0, earliest_date)
a_output(1, i) = a_input(1, earliest_date)
a_input(0, earliest_date) = "" ' this one is done so skip next time '
Next
SortByDate = a_output
End Function
I am not really familiar with asp-classic functions, though i am now working with a .asp file that displays records from a SQL database upon a java-script onChange event in a drop-down menu. What I'm trying to achieve is to display these records in the format below, and for all of them to be written to a text file without being called through java-script even from the drop-down menu.
Here's what I'm working with so far:
<!--#include virtual="/includes/functions.asp" -->
<%
intBusiness_Catagory = Request("select_catagory")
Set thisConn = Server.CreateObject("ADODB.Connection")
thisConn.Open CreateAfccDSN()
SelectSQL = "SELECT * FROM BusinessInfo WHERE ((CatID = " & intBusiness_Catagory & ") or (CatID2 = " & intBusiness_Catagory & ") or (CatID3 = " & intBusiness_Catagory & ")) and (intStatusCodeID = 1) and (intOnWeb = 1) Order By vcBusinessName"
Set SelectRs = thisConn.Execute(SelectSQL)
If SelectRs.EOF Then
Response.Write("No members found for selected category.<br> Please search <a href='javascript:history.back()'>again</a>.")
Else
%>
<b>Member Search Results:</b>
<p>
<%
End If
If Not SelectRs.BOF AND Not SelectRs.EOF then
SelectRs.MoveFirst
Do Until SelectRs.EOF
%>
<b><%=SelectRs("vcBusinessName") %></b><br>
<%=SelectRs("vcPhone") %><br>
<%=SelectRs("vcPAddress") %><br>
<%=SelectRs("vcPCity") %>, <%=SelectRs("vcPState") %> <%=SelectRs("vcPZipCode") %><br>
<%
If isNull(SelectRs("vcURL")) then
Else
%>
<b>Website: </b><%=SelectRs("vcURL") %>
<%
End If
%>
<p>
<hr>
<%
SelectRs.MoveNext
Loop
%>
<%
End If
SelectRs.Close
Set SelectRs = Nothing
%>
<p style="text-align: right"><small>Back to directory index</small></p>
Anyone can assist with a solution to this? Thanks.
You'd simply dump the results of your SQL into an adodb recordset as you already have, then loop through the recordset and write the csv file using the fso com object.
Example Code (untested)
dim fs, HeadersRow, TempRow, objFolder, DateStr
'#### Buld a NTFS safe filename based on Date
DateStr = now()
DateStr = Replace(DateStr, "/", "_")
DateStr = Replace(DateStr, ":", "_")
'#### Initalise FileSystemObject
Set fs = Server.CreateObject("Scripting.FileSystemObject")
'#### Delete any old Report_ files (optional
Set objFolder = fs.GetFolder(Server.MapPath("Reports"))
For Each objFile in objFolder.Files
FileName = objFile.Name
if left(FileName,7) = "Report_" then
if fs.FileExists(Server.MapPath("Reports") & "/" & FileName) then
on error resume next
fs.DeleteFile(Server.MapPath("Reports") & "/" & FileName)
on error goto 0
end if
end if
Next
Set objFolder = Nothing
'#### Create a Uniquqe ID for this report
NewFileName = "Report_" & DateStr & ".csv"
'#### next, get the Query and Populate RS
SQL = "SELECT * FROM whatever"
SET RS = db.Execute(SQL)
'#### WE now have a RS, first we need the column headers:
For fnum = 0 To RS.Fields.Count-1
HeadersRow = HeadersRow & "," & RS.Fields(fnum).Name & ""
Next
'#### The loop will have made a string like: ,"col1", "col2", "col3", "col4"
'#### Remove the leading comma ,
dim LengthInt
LengthInt = len(HeadersRow)
HeadersRow = right(HeadersRow, LengthInt - 1)
'#### Dump the headers to the CSV Report
OutputToCsv HeadersRow, NewFileName
TempRow = ""
'#### now loop through all the data and dump in CSV report too
Do Until RS.EOF
TempRow = ""
For fnum = 0 To RS.Fields.Count-1
TempRow = TempRow & "," & RS.Fields(fnum).Value & ""
Next
'#### Again, remove the leading comma, then send to CSV
LengthInt = len(TempRow)
TempRow = right(TempRow, LengthInt - 1)
OutputToCsv TempRow, NewFileName
RS.MoveNext
Loop
'#### Functions
function OutputToCsv (strToWrite, FileName)
'#### Simple function to write a line to a given file
'#### Not the most efficent way of doing it but very re-usable
dim fs
Set fs=Server.CreateObject("Scripting.FileSystemObject")
If (fs.FileExists(server.MapPath("\") & "\Reports\" & FileName))=true Then
set fname = fs.OpenTextFile(server.MapPath("\") & "\Reports\" & FileName, 8, True)
Else
set fname = fs.CreateTextFile(server.MapPath("\") & "\Reports\" & FileName,true)
End If
fname.WriteLine(strToWrite)
fname.Close
set fname=nothing
set fs=nothing
end function