VB6 - Items not adding to collection - vb6

I'm having problems building a collection of data. The problem code is as follows:
'Basic defitions are as follows:
Private mCol As Collection
Dim mcnn As ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim uCustomClass As CustomClass
On Error GoTo 0
'set Find to false to catch any errors
Find = False
'checks for an active connection and then..
Set mCol = Nothing
Set mCol = New Collection
With mrs
.Open AN_SQL_SELECT_STATEMENT , mcnn, adOpenForwardOnly, adLockOptimistic
While Not .EOF
Set uCustomClass = New CustomClass
Set uCustomClass.Connection = mcnn
uCustomClass.CustomerName = NullToEquiv(.Fields("customer_name").Value,NULL_STRING)
uCustomClass.NumberOfOrders = NullToEquiv(.Fields("num_of_orders").Value, NULL_LONG)
uCustomClass.FavoriteColour = NullToEquiv(.Fields("favorite_colour").Value, NULL_STRING)
'Cache orginal values in case the keys change
uCustomClass.CacheOriginalValues
'add to collection
mCol.Add uCustomClass
.MoveNext
Wend
Now the result of this in run time is that the uCustomClass tree structure looks like:
-uCustomClass
+connection
count
+ mcnn
-mCol
+Item1
+Item2
+Item3
+mrs
mvarChangedCount
+NewEnum
It's all good bar I'm not getting Item1, Item2 and Item3 directly under the uCustomClass but only in mCol. I've what appears to be the exact same code running elsewhere for a different custom class and I'm getting what I want e.g.
-uCustomClassThatWorks
+connection
count
+ mcnn
-mCol
+Item1
+Item2
+Item3
+mrs
mvarChangedCount
+NewEnum
+Item1
+Item2
+Item3
Any ideas where the problem might be?

Not sure how uCustomClass would ever get those items added. Is there some missing code or something?
One point worth making is that collections can't have the same keys more than once, which would explain why they are able to be added in one area, but not able to be added again. There might be something that is even trimming strings or something that would aggravate the situation. So just make sure your keys are unique.

Related

Run-time error '91' when adding data to a record set

I want to insert some information into a database in VB6, but I get runtime error '91'.
My code:
Private sub btn_click()
Fname = txtFname.text
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields("Fname") = Fname
Adodc1.Recordset.Update
End sub
The debuger shows error on: Adodc.Recordset.AddNew
You haven't posted the rest of the code as to where the Adhoc1 variable is created etc...
This post suggests that the RecordSet has not been initialized prior to working with it, but it's hard to be more specific without the code.
Runtime error '91' is Object variable or With block variable not set, which is a slightly confusing way to say that your variable contains Nothing.
You either forgot to initialise the Adodc1 properly, or, and this is more likely, you need to initialise Adodc1.RecordSet to something useful (like a Set Adodc1.RecordSet = New RecordSet or related) before you can use it.
By the way you posted the code, I believe that you will populate a Recordset to insert into the database. Try as follows:
sub btn_click()
dim Adodc1 as adodb.recordset
set Adodc1 = new adodb.recordset
Fname = txtFname.text
Rs.Fields.Append "Fname", adVarChar, 20 'adVarChar = text, followed by the amount of characters
Adodc1.open()
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields("Fname") = Fname
Adodc1.Recordset.Update
End sub

VB 6.0 Add new record raises error object variable or With block not set

I want to add a new record to my database on the form load event - that is, as soon as my form loads the text box will be blank, which will enable the user to input info that will then be added to the database.
When my code is this, however:
Private Sub Form_Load()
Data1.Recordset.AddNew
End Sub
I keep getting an error:
run-time error '91'; object variable or With block not set.
what should I do?
place your code in Form_Initialize()
Private Sub Form_Initialize()
Data1.Recordset.AddNew
End Sub
I think; You need to change it to something like this:
Private Sub Form_Load()
Dim rs As ADODB.Recordset
Set rs = Data1.Recordset
rs.AddNew
rs!Column1 = 1
rs!Column2 = "test
rs.Update
End Sub
Now, If you have the error message over Set rs = Data1.Recordset then we need to know what is Data1.
Just add adodc1.refresh before addnew line. It will solve it.

Assign Attachment Field To Variable in Access 2010

I'm trying to understand how to work with the new Attachment field that is available in Access 2010. I would like to assign the value from the table directly into a variable. I know that I can do this if I use an intermediary form, but this seems like sloppy coding to rely on a form in order to grab a value from a table. Is there some way to grab what is in an attachment field and assign it directly to a variable? I have multiple instances where this would be handy for me. The first instance is I want to grab a photo stored in an attachment field to assign to the ribbon. A second instance is to load a company logo from a table into a variable and keep it in memory to use throughout the program as needed.
The code I have so far is this, but it gives me a type mismatch error:
Dim ParentRS As Recordset, ChildRS As Recordset, Img As Attachment
Set ParentRS = CurrentDb.OpenRecordset("SELECT * FROM LtblImg;", dbOpenSnapshot)
If ParentRS.RecordCount > 0 Then
Set ChildRS = ParentRS("Img").Value
If ChildRS.RecordCount > 0 Then
Set Img = ChildRS("FileData")
End If
ChildRS.Close
End If
ParentRS.Close
Yes, Dim Img As Attachment looks tempting, but Attachment (which is actually Access.Attachment) refers to an Attachment control that could be used on a form (just like Access.TextBox) and does not appear to be suitable for your intended purpose.
The only native VBA type for storing this sort of binary data is an array of Byte values, but often when dealing with byte arrays we wind up looping through and processing them byte-by-byte, which is tedious and inefficient.
You might consider using a binary ADODB.Stream object as your "variable". You could create a function to retrieve the attachment bytes and return them in a Stream like so
Option Compare Database
Option Explicit
Public Function GetLogoAsStream() As ADODB.Stream
Dim cdb As DAO.Database, rstMain As DAO.Recordset, rstAttach As DAO.Recordset2, fldAttach As DAO.Field2
' Project references required for early binding:
' Windows Script Host Object Model
' Microsoft ActiveX Data Objects 2.8 Library
Dim fso As FileSystemObject, tempFileSpec As String
Static strm As ADODB.Stream
If strm Is Nothing Then
Set fso = New FileSystemObject
tempFileSpec = fso.GetSpecialFolder(TemporaryFolder) & "\" & fso.GetTempName
Set fso = Nothing
Set cdb = CurrentDb
Set rstMain = cdb.OpenRecordset( _
"SELECT [AttachmentFiles] " & _
"FROM [AttachmentsTable] " & _
"WHERE [Description]='SO logo'", _
dbOpenSnapshot)
Set rstAttach = rstMain("AttachmentFiles").Value
' make sure we use the correct file extension
tempFileSpec = tempFileSpec & "." & rstAttach.Fields("FileType").Value
Set fldAttach = rstAttach.Fields("FileData")
fldAttach.SaveToFile tempFileSpec
Set fldAttach = Nothing
rstAttach.Close
Set rstAttach = Nothing
rstMain.Close
Set rstMain = Nothing
Set cdb = Nothing
Set strm = New ADODB.Stream
strm.Type = adTypeBinary
strm.Open
strm.LoadFromFile tempFileSpec
Kill tempFileSpec
End If
strm.Position = 0
Set GetLogoAsStream = strm
End Function
and then if you had, say, a Report like this with an empty Image control
and an On Load event procedure like this to load the Image control's .PictureData from your "variable" (actually a Function returning an ADODB.Stream)
Private Sub Report_Load()
Me.LogoImage.PictureData = GetLogoAsStream.Read
End Sub
it could produce something like this

VB6 execution with database is different when stepping through vs running

I've come across a weird scenario with the following code in a vb6 app:
Private database As dao.Database
Set database = openDaoDatabase([some valid database location], False)
createDBField database, "Table", "FirstRow", dao.dbInteger, 0, "0"
Public Sub createDBField(targetDB As dao.Database, strTable As String, strField As String, dbType As dao.DataTypeEnum, Size As Integer, strDefValue As String)
Dim td As dao.TableDef
Dim fld As dao.field
Set td = targetDB.TableDefs(strTable)
Set fld = td.CreateField(strField, dbType, 0)
If dbType = dao.DataTypeEnum.dbText Or dbType = dao.DataTypeEnum.dbMemo Then fld.AllowZeroLength = True
If strDefValue <> "" Then fld.DefaultValue = strDefValue
td.Fields.Append fld
Set td = Nothing
Set fld = Nothing
End Sub
When I step through, everything works and the new field is added to the database. However, when I simply run the application, the database becomes corrupted due to 'inconsistency'. I added some error handling and now get the error: "Unrecognized database format: [path]".
After searching the Microsoft database, I found a solution: http://support.microsoft.com/kb/238401. I'm using the Microsoft.Jet.OLEDB.4.0 provider, have SP6 installed and have a reference to the Microsoft DAO 3.6 Object Library, but it's still not working!
Any thoughts?
Update:
td.Fields.Append fld is the culprit. After removing all silent error handling, I was able to catch an error: "Run-time error 3343 Unrecognized Database Format". For some reason, I can just step over it though.
I suspect your problem is happening because of the AllowZeroLength property. I suspect the field should be added to the fields collection and the AllowZeroLength property updated.
After
td.Fields.Append fld
put something like the following:
Set tdfField = tabledef.Fields(strField)
Set prp = tdfField.CreateProperty("AllowZeroLength", dbboolean, True)
tdfField.Properties.Append prp
Note the above is aircode and not tested.
That said, it doesn't make a lot of sense to me for a text or MEMO field's AllowZeroLength property to default to True. After all, the front end user can't really visually distinguish between the NULL value and a zero length string value.
I don't see a call to database.close that might be the cause. If your VB app terminates abruptly that might leave the DB in an inconsistent state.
Which line is the error occurring on? Usually when I run into VB errors like this they are timing related. Stepping through gives enough time for something to finish processing. Try adding some sleep commands before the statement that is causing the error.

Sorting a collection in classic ASP

It's quite a simple question - how do I sort a collection?
I've got a CSV file with rows in a random order. I'd like to sort the rows according to the date in one column. Do I add the rows to a recordset? Can I sort with a Scripting.Dictionary?
I've clearly been spoilt with .NET and Linq, and now I find myself back in the land of classic asp, realising I must have known this 7 years ago, and missing generics immensely. I feel like a complete n00b.
In this case I would get help from big brother .net. It's possible to use System.Collections.Sortedlist within your ASP app and get your key value pairs sorted.
set list = server.createObject("System.Collections.Sortedlist")
with list
.add "something", "YY"
.add "something else", "XX"
end with
for i = 0 to list.count - 1
response.write(list.getKey(i) & " = " & list.getByIndex(i))
next
Btw if the following .net classes are available too:
System.Collections.Queue
System.Collections.Stack
System.Collections.ArrayList
System.Collections.SortedList
System.Collections.Hashtable
System.IO.StringWriter
System.IO.MemoryStream;
Also see: Marvels of COM .NET interop
I'd go with the RecordSet approach. Use the Text Driver. You'll need to change the directory in the connection string and the filename in the select statement. the Extended Property "HDR=Yes" specifies that there's a header row in the CSV which I suggest as it will make writing the psuedo SQL easier.
<%
Dim strConnection, conn, rs, strSQL
strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\inetpub\wwwroot\;Extended Properties='text;HDR=Yes;FMT=Delimited';"
Set conn = Server.CreateObject("ADODB.Connection")
conn.Open strConnection
Set rs = Server.CreateObject("ADODB.recordset")
strSQL = "SELECT * FROM test.csv order by date desc"
rs.open strSQL, conn, 3,3
WHILE NOT rs.EOF
Response.Write(rs("date") & "<br/>")
rs.MoveNext
WEND
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
%>
It's been a long time for me too. IIRC you don't have an option out of the box.
If I were you I'd put all the data in an array and then sort the array. I found a QuickSort implementation here: https://web.archive.org/web/20210125130007/http://www.4guysfromrolla.com/webtech/012799-3.shtml
Also look at the "Bubble Sort", works excellent with those classic asp tag cloud.
https://web.archive.org/web/20180927040044/http://www.4guysfromrolla.com:80/webtech/011001-1.shtml
A late late answer to this, but still of value.
I was working with small collections so could afford the approach where I inserted the item in the correct place on each occasion, effectively reconstructing the collection on each addition.
The VBScript class is as follows:
'Simple collection manager class.
'Performs the opration of adding/setting a collection item.
'Encapulated off here in order to delegate responsibility away from the collection class.
Class clsCollectionManager
Public Sub PopulateCollectionItem(collection, strKey, Value)
If collection.Exists(strKey) Then
If (VarType(Value) = vbObject) Then
Set collection.Item(strKey) = Value
Else
collection.Item(strKey) = Value
End If
Else
Call collection.Add(strKey, Value)
End If
End Sub
'take a collection and a new element as input parameters, an spit out a brand new collection
'with the new item iserted into the correct location by order
'This works on the assumption that the collection it is receiving is already ordered
'(which it should be if we always use this method to populate the item)
'This mutates the passed collection, so we highlight this by marking it as byref
'(this is not strictly necessary as objects are passed by reference anyway)
Public Sub AddCollectionItemInOrder(byref existingCollection, strNewKey, Value)
Dim orderedCollection: Set orderedCollection = Server.CreateObject("Scripting.Dictionary")
Dim strExistingKey
'If there is something already in our recordset then we need to add it in order.
'There is no sorting available for a collection (or an array) in VBScript. Therefore we have to do it ourself.
'First, iterate over eveything in our current collection. We have to assume that it is itself sorted.
For Each strExistingKey In existingCollection
'if the new item doesn't exist AND it occurs after the current item, then add the new item in now
'(before adding in the current item.)
If (Not orderedCollection.Exists(strNewKey)) And (strExistingKey > strNewKey) Then
Call PopulateCollectionItem(orderedCollection, strNewKey, Value)
End If
Call PopulateCollectionItem(orderedCollection, strExistingKey, existingCollection.item(strExistingKey))
Next
'Finally check to see if it still doesn't exist.
'It won't if the last place for it is at the very end, or the original collection was empty
If (Not orderedCollection.Exists(strNewKey)) Then
Call PopulateCollectionItem(orderedCollection, strNewKey, Value)
End If
Set existingCollection = orderedCollection
End Sub
End Class

Resources