need help with ADO in VB6 - vb6

I am making a POS system for a friend of mine, real small and simple.
Pretty much everything is coded right now except and inventory view
I am trying to make it so when it clicks a button it will load up into a listview
the UPC codes and the name associated with that UPC.
I am new to programming and I am trying to do this myself. I know I need to get a number of items in the database (how many UPC's) and then do a loop adding info in a listview.
but I am having trouble getting how many lines are in the database to start and end a loop

This would be easier if you posted some of your code, so we could see what you are starting with.
However, you should be able to do something like THIS (My VB/ADO is rusty, so I might blow the syntax a little. As Chris notes above, VB6 is getting a little long in the tooth . . .). In most cases, you should not need to know how many records are returned in order to populate your listView - Just use a "Do Until " Loop As follows:
Public Sub LoadListview()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
SQL = _
"SELECT . . . " & _
"FROM . . . " & _
"WHERE . . . "
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "YourConnectionString"
.Open
End With
Set rs = New ADODB.Recordset
rs.Open SQL, cn, adOpenForwardOnly, adLockReadOnly
With rs
If Not .EOF Then
Do Until .EOF
' Your code to populate your ListView Here
.MoveNext
Loop
End If
End With
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
Note that I have simplified things here a little. in reality, if you are passing criteria into the WHERE clause, you should generally use PARAMETERS in conjunction with an ADODB.Command Object. I did not include an ADODB.Command in this example.

Related

how can i add VB6 Adodc.recordset.find

I'm trying to search and display my database on textbox using VB6, but im not quite sure where the problem is,how would i display my data base in textboxes after i search for it?
I've aldready tried different set of codes but none seems to work. i've also tried the inputbox.
Dim search As String
search = Text5.Text
Adodc1.Recordset.Find "Studno = " & search
If Adodc1.Recordset.EOF Then
MsgBox "NO record"
Else
Adodc1.Recordset.Fields("Studno") = Text1.Text
Adodc1.Recordset.Fields("Studname") = Text2.Text
Adodc1.Recordset.Fields("Age") = Text3.Text
Adodc1.Recordset.Fields("Address") = Text4.Text
End If
i would like to display all the fields in the textboxes after i searched for the studno.
You're trying to add the content of the textboxes to the recordset fields rather than the other way round. Try:
Text1.Text = Adodc1.Recordset.Fields("Studno")
Text2.Text = Adodc1.Recordset.Fields("Studname")
Text3.Text = Adodc1.Recordset.Fields("Age")
Text4.Text = Adodc1.Recordset.Fields("Address")
Ok. Updated answer. Try:
Adodc1.Recordset.Find "Studno = '" & search & "'"
and put a breakpoint on the first line after the Else statement to make sure it's getting that far. (Note there is a single quote both before and after the search string.)
You'll still need the changes I posted originally to actually see the results.

Creating a copy of a recordset in a Session variable

This is a follow on from a question I asked here > Converting an HTML table to JSON to pass to an AJAX call for downloading as a CSV
I have a report page that outputs a number of recordsets as graphs and tables but also buttons to "download as a CSV file" I have a generic function that will take any number of recordsets (as the stored proc returns multiple recordsets) and outputs a CSV so thats fine.
The issue is I want to set the output of my stored proc into a Session("DATA") variable and then create a "copy" of the data in memory so that whenever the "download" button is pressed I can just look for a Session("DATA") variable and output it if it exists.
The problem is that when I set a recordset object to point at the Session it is referential so that once it has looped through all the recordsets outputting them on the page the Session is then empty (or at the end of all the recordsets - so it's an object with no data in it)
How can I Create a "copy" of the recordset instead of a pointer so that the Session always has the full recordset in it e.g
Set Session("DATA") = objCon.Execute(strSQL) '* returns multiple recordsets
Set objRS = Session("DATA")
Do While Not objRS.EOF......
'* BUT now when I want to access Session("DATA") it is at the start of all the recordsets and not a spent, EOF of the last recordset due to me looping through objRS
I could have a function that loops through the recordsets and makes a duplicate but then that seems like a lot of effort and performance and I thought there must be a way to copy the recordsets for the session somehow without looping through it multiple times.
If I have to create a "Copy" object function then I suppose I will have to but is there not an easier way in ASP CLASSIC to create a copy of an object and not a reference pointer?
You can read the entire recordset into an array, using GetRows:
'GetDataSet
' Returns a table of data based on the supplied SQL statement and connection string.
'Parameters:
' sqlString (string) - The SQL string to be sent. This can be either a valid SQL string or an Application setting
' specified using the '#' prefix (e.g. #GET_USERNAME)
' connString (string) - The database connection string. Either a valid connection string, an Application setting
' (using the '#' prefix, e.g. #CONN_STRING) or an AMC (AppModeConnection string).
'Usage:
' dataSet = GetDataSet(sqlString, connString)
'Description:
' This function generates a table of information in a 2 dimensional array. The first dimension represents the columns
' and the second the rows. If an error occurs while the routine is executing the array and the base index (0,0) is set
' to C_ERROR, (0,1) to the VBScript error index, and (0,2) to the VBScript error description.
'Notes:
' Updated this function to take advantage of the AppModeConnection feature.
'Revisions:
' 30/09/2015 1.1 Added facility to allow recovery of Application settings as Query and connection strings using
' '#', (e.g.: ds = GetDataSet("#GET_USER_DETAIL", "#CONN_DATABASE")
' 25/09/2015 1.0 Added AMC support for Classic ASP. The system will test to see if there is a valid connection
' string based on the current application mode and the connection string provided (e.g. if the
' connection string is 'CONN_DATABASE' and the application mode is 'DEV' then the final connection
' string will be 'CONN_DATABASE_DEV'. A connection string should be present to cover this.
' < 25/09/2015 0.1 Bug ironed out that prevented closing of the database.
' < 25/09/2015 0.0 Initial version.
function GetDataSet(ByVal sqlString, ByVal connString)
'Test to see if there's an application connection string first...
If Left(connString, 1) = "#" Then
connString = Application(Mid(connString, 2))
Else
Dim amc
amc = AppModeConnection(connString)
If amc <> "" then connString = amc
End If
'Test the SQL string to see if it's stored as an Application setting...
If Left(sqlString, 1) = "#" Then sqlString = Application(Mid(sqlString, 2))
'Define the initial output...
dim rV, rs
If (Application("APP_MODE") = Application("MODE_DEV") And Application("DEV_TRAP_ERRORS")) Or _
(Application("APP_MODE") <> Application("MODE_DEV")) Then On Error Resume Next
'Define and open the recordset object...
set rs = Server.CreateObject("ADODB.RecordSet")
rs.Open sqlString, connString, 0, 1, 1
'Initialise an empty value for the containing array...
redim rV(0,0)
rV(0,0) = C_NO_DATA
'Deal with any errors...
if not rs.EOF and not rs.BOF then
'Store the data...
rV = rs.GetRows()
'Tidy up...
rs.close
set rs = nothing
select case err.number
case 3021 'No data returned
'Do nothing as the initial value will still exist (C_NO_DATA)
case 0 'No error
'Do nothing as data has been returned
case else
redim rV(4,0)
rV(C_COL_IDENTIFIER,0) = C_ERROR
rV(C_COL_ERROR_ID,0) = err.number
rV(C_COL_ERROR_MESSAGE,0) = err.description
rV(C_COL_SQL,0) = sqlString
rV(C_COL_CONNECTION,0) = "Withheld"
end select
end if
on error goto 0
'Return the array...
GetDataSet = rV
end function
This is my own in depth version which does some funky stuff with connection strings etc, so feel free to use it, but note that you'll have to set-up the handling for the connection strings etc. Within the code, though, is the core element - the GetRows, that you require.
You shouldn't need to set any Session variables, simply process all in the same page, as per marekful's answer to your post. You can do this using a simple For...Next loop using an array.
To use the function above simply declare your SQL and call it like so...
Dim ds, sql
sql = "EXEC prc_get_report_data "
ds = GetDataSet(sql, "#my_conn")
(Note: read the code comments about the connection strings).
The array returned from this is obviously two dimensional zero based, where x = columns, y = rows:
ds(x, y)
What I tend to do is define constants to cover the column names, matching them to the equivalents in the database...
Const COL_ID = 0 'Column 0 is the ID field (note zero based)
Const COL_TITLE = 1 'Title field
Const COL_DESCRIPTION = 2 'Description field
...and so on.
Then you can reference them eaasily:
If ds(COL_ID, row) = 14 Then
Use the UBound function to get the extents of the array...
Dim row, rows
For rows = 0 To UBound(ds, 2) '2 is the second dimension of the array (note not zero based
If ds(COL_ID, row) = avalue Then
You get the idea.

Excel VBA Outlook / Mail functions requires recalculation or sets all formulas to #Value

I'll try to keep it short and precise.
I really hope you can help me.
I am facing the following problem:
Background:
Workbook with a lot of formulas -> Calculation set to manual
Recalculation takes 5-10 minutes each time
What I want to do:
Generate ranges of data individually for multiple people
then select those ranges, and paste them into the body of an e-mail
send those e-mails one by one
What is the problem?
If I use the "Envelope" method to prepare the e-mails everything is fine until I press send. However, every time I press send excel automatically recalculates the entire Workbook. Obviously I do not want to wait 5-10 minutes to send out each e-mail (always between 10 and 20)
Since I thought it might have to do with the "Envelope" method I decided to switch to creating an e-mail directly via Outlook (outlook object). It worked fine as far as opening the e-mail and sending it without recalculation. However, after the e-mail is opened by Outlook, all(!) formulas in the entire Workbook are set to #Value. This obviously also forces me to recalculate as I cannot create the table for the next person's e-mail.
Does anyone know what is causing the recalculation/error values and what I can do to stop it? I'd be really glad about any suggested solutions.
I am also attaching my code, though I doubt it will help in clearing up the issue
`'DESCRIPTION:
'This routine prepares an e-mail for requesting the progress estimates from the deliverable owners
'1. set all the values based on named ranges in PI and Config sheets
'2. Concatenate all relevant strings to full e-mail text
'3. select PI table
'4. Create e-mail and display
Sub PrepareEmail()
Dim s_EmailAddress As String, s_FirstName As String
Dim s_Email_Greeting As String, s_Email_MainText1 As String, s_Email_MainText2 As String, s_Email_DeadlineRequest As String
Dim s_Email_Deadline As String, s_Email_Subject As String, s_Email_ClosingStatement As String, s_Email_SenderName As String, s_Email_CC As String
Dim s_Email_Full As String
Dim rng_PI_TableValues As Range, rng_PI_TableFull As Range
Dim s_Email_FullText As String
Dim obj_OutApp As Object
Dim obj_OutMail As Object
s_EmailAddress = [ptr_PI_Email]
s_FirstName = [ptr_PI_FirstName]
s_Email_Subject = [ptr_Config_PIEmail_Subject]
s_Email_Greeting = [ptr_Config_PIEmail_Greeting]
s_Email_MainText1 = [ptr_Config_PIEmail_MainText1]
s_Email_MainText2 = [ptr_Config_PIEmail_MainText2]
s_Email_DeadlineRequest = [ptr_Config_PIEmail_DeadlineRequest]
s_Email_Deadline = [ptr_Config_PIEmail_Deadline]
s_Email_ClosingStatement = [ptr_Config_PIEmail_ClosingStatement]
s_Email_SenderName = [ptr_Config_PIEmail_SenderName]
s_Email_CC = [ptr_Config_PIEmail_CC]
'Concatenate full e-mail (using HTML):
s_Email_Full = _
"<basefont face=""Calibri"">" _
& s_Email_Greeting & " " _
& s_FirstName & ", " & "<br> <br>" _
& s_Email_MainText1 & "<br>" _
& s_Email_MainText2 & "<br> <br>" _
& "<b>" & s_Email_DeadlineRequest & " " _
& s_Email_Deadline & "</b>" & "<br> <br>" _
& s_Email_ClosingStatement & "," & "<br>" _
& s_Email_SenderName _
& "<br><br><br>"
'-------------------------------------------------------
Set rng_PI_TableValues = Range("tbl_PI_ProgressInput")
Set rng_PI_TableFull = Union(rng_PI_TableValues, Range("tbl_PI_ProgressInput[#Headers]"))
Application.EnableEvents = False
Application.ScreenUpdating = False
Set obj_OutApp = CreateObject("Outlook.Application")
Set obj_OutMail = obj_OutApp.CreateItem(0)
With obj_OutMail
.To = s_EmailAddress
.CC = s_Email_CC
.Subject = s_Email_Subject
.HTMLBody = s_Email_Full & RangetoHTML(rng_PI_TableFull)
.Display
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Call update_Status
End Sub
`
If you're using RangeToHTML from Ron de Bruin's website, that's what's causing your problem. That utility is fine if you need perfect fidelity and have a heavily formatted bu otherwise fairly simple range. But if your range has a bunch of dependencies, you'll have problems. It's putting the range into its own workbook, so any formulas that refer to data outside the range get funky.
If you need perfect fidelity, then you're stuck because the only way it will be perfect is by saving the range as HTML and reading that back. But if you don't have a bunch of heavy formatting or you just need a nice looking table, then I suggest you write your own RangeToHTML function that produces the HTML strings.
David McRitchie has some functions that do a pretty good job if you don't want to roll your own. http://dmcritchie.mvps.org/excel/xl2html.htm
Also, I don't know what update_Status does, but if it's causing a recalc, then you have two problems. If that's the case, figure out how to store up all the stuff that update_status does and do it once at the end rather than in the loop.

visual basic 6 access 2007 database programming cascading combo boxes

I have a table named: schoolInfo in access 2007 and it has two fields (schName and mjrName).
Now I'm trying to design a combo in Visual Basic 6 (cboMajors) which is related to the other combo (cboSchool).
As a matter of fact I want to have to cascading combo boxes. When I choose an Item in cboSchool the other combo should represents just the related majors for that school (records with schName=x and mjrName=y).
Private Sub Form_Activate()
connection
' the Connection is a code in module contains codes are needed to make the connection between form and the database
fill_schools
fill_majors
End Sub
Also,
Private Sub fill_schools()
With rs
.Open "select DISTINCT schName from tblSchoolsInfo", cn, 2, 3
Do While Not .EOF
cboSchool.AddItem (.Fields(0))
.MoveNext
Loop
End With
rs.Close
End Sub
Private Sub fill_majors()
With rs
.Open "select DISTINCT mjrName from tblSchoolsInfo where schName= '" & Me.cboSchool & " '", cn, 2, 3
Do While Not .EOF
cboMajors.AddItem (.Fields(0))
.MoveNext
Loop
End With
End Sub
Now: the first combo get correct values but the second one is completely empty.
In the snippet of code you have given us, I can't see anywhere where you actually select the school in Form_Activate(). This means that by the end of that procedure, there will be no selection in school, so fill_majors() will execute:
select DISTINCT mjrName from tblSchoolsInfo where schName= ' '
Incidentally, is that trailing space deliberate? In which case, this won't return records even if a school is selected.
The OP solved this in dreamincode.net. He was tacking an extra space on the end of his combo box string: Me.cboSchool & " '"
I've always wanted to say this: "This behavior is by design." :)
just a suggestion did you check the
cboMajors.AddItem (.Fields(0)) <--- .Fields()

What's the most efficient way for accessing a single record in an ADO recordset?

I want to access individual records in a classic ADO recordset without enumerating over the entire recordset using .MoveNext. I'm aware of using AbsolutePosition as well as .Filter =. What's the best way?
I'm likely going to be accessing the recordset several times pulling out individual records that match a list of records in a particular field. For example, I have a recordset with records that have field values ranging from 1 to 100, I might have a separate array containing just {34, 64, 72}, and I want to do something to only the records in the recordset whose IDs are contained in the array.
If you are using server-side cursors, then the best method depends on the underlying OLE DB provider that you are using. It is quite possible that each access of the record could result in another trip to the server to read the data.
If you can use a client-side cursor, then I suspect that AbsolutePosition will be the best method to move to each record repeatedly. I believe that using a filter with a client-side cursor would require that it spin through each record matching the filter condition.
I ended up rewriting my answer due to new information, so:
My suggestion is to set the Filter property to what you want, then enumerate through the resulting subset and assign the Bookmark value of each record in the subset to a variable that you can easily match up with the IDs (so you might want to put them in an array in the order that their IDs are in the ID array you mention).
Use the Filter function on the Recordset object.
rs.Filter = "ID = '" & strID & "'"
I'm using this function all the time
Public Function InitIndexCollection( _
rs As Recordset, _
sFld As String, _
Optional sFld2 As String, _
Optional sFld3 As String, _
Optional ByVal HasDuplicates As Boolean) As Collection
Const FUNC_NAME As String = "InitIndexCollection"
Dim oFld As ADODB.Field
Dim oFld2 As ADODB.Field
Dim oFld3 As ADODB.Field
On Error GoTo EH
Set InitIndexCollection = New Collection
If Not IsRecordsetEmpty(rs) Then
Set oFld = rs.Fields(sFld)
If LenB(sFld2) <> 0 Then
Set oFld2 = rs.Fields(sFld2)
End If
If LenB(sFld3) <> 0 Then
Set oFld3 = rs.Fields(sFld3)
End If
If HasDuplicates Then
On Error Resume Next
End If
With rs
If oFld2 Is Nothing Then
.MoveFirst
Do While Not .EOF
InitIndexCollection.Add .Bookmark, C_Str(oFld.Value)
.MoveNext
Loop
ElseIf oFld3 Is Nothing Then
.MoveFirst
Do While Not .EOF
InitIndexCollection.Add .Bookmark, C_Str(oFld.Value) & "#" & C_Str(oFld2.Value)
.MoveNext
Loop
Else
.MoveFirst
Do While Not .EOF
InitIndexCollection.Add .Bookmark, C_Str(oFld.Value) & "#" & C_Str(oFld2.Value) & "#" & C_Str(oFld3.Value)
.MoveNext
Loop
End If
End With
End If
Exit Function
EH:
RaiseError FUNC_NAME
Resume Next
End Function

Resources