is there a way to do SELECT SCOPE_IDENTITY() in ADODB? - sql

With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("datapath") = dpath
.Fields("analysistime") = atime
.Fields("reporttime") = rtime
.Fields("lastcalib") = lcalib
.Fields("analystname") = aname
.Fields("reportname") = rname
.Fields("batchstate") = bstate
.Fields("instrument") = instrument
.Update ' stores the new record
End With
this is how i am adding records. is it possibel to do something lik ethis???:
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("datapath") = dpath
.Fields("analysistime") = atime
.Fields("reporttime") = rtime
.Fields("lastcalib") = lcalib
.Fields("analystname") = aname
.Fields("reportname") = rname
.Fields("batchstate") = bstate
.Fields("instrument") = instrument
SCOPE_IDENTITY() <----------------
.Update ' stores the new record
End With

No, there is not.
You should make an explicit INSERT statement followed by a call to SCOPE_IDENTITY in the same batch.

After you have executed the Update command, the identity will be placed in the corresponding field in the recordset. You can read it from there.
Example:
id = .Fields("id")

Related

IF 'x' matches 'y' then Merge With Existing Else Create New

I need to import 'contacts' into my database from several external sources.
Some 'contacts' may already exist so I only need 'new' data.
I've written an update records code however it will overwrite all data therefore damaging the integrity of the table as the old data may contain some valid values.
I tried using an update/append query however this only OVERWROTE the values of the original field not UPDATED IF OLD VALUE WAS NULL/FALSE ONLY. The issue with this is it will apply/remove profile flags that result in correspondence and data usage (Incorrect update = potential breach of GDPR).
I can't program in SQL, I understand how the functions work and what they do but not how to compile/what order (yet) hence using VBA for now.
Dim myR As Recordset
Dim myR2 As Recordset
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
Else
myR2.Edit
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![Website] = myR![Website]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Surpress]
myR2.Update
End If
myR.MoveNext
Loop
Set myR = Nothing
End Sub
Is there a simpler way to write this or should I be utilising the code
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
For each value, creating effectively 15-20 subs and a macro to run all together?
I tried several code variations attempting to include elseIf, isNull() and isFalse() however they always failed to compile or no update was completed/records changed.
I need the code to do the following:
Check the contact exists in contacts table
If contact does not exist, add all data
If contact does exist, add new data or update yes/no fields from no to yes
NOTE: Currently 'contacts' table is empty as we need to create new/merge duplicates before the data is imported to the 'contacts' table.
So Contacts is currently:
Email Name Surname
- - -
- - -
- - -
- - -
Staging - Import is currently:
Email Name Surname
b#b.c Brad
t#b.c Tony Tiger
b#b.c B Pitt
r#b.c Ryan Reynolds
Contacts should look like this after completed:
Email Name Surname
t#b.c Tony Tiger
b#b.c Brad Pitt
r#b.c Ryan Reynolds
Determining what to update or add when comparing string data can be quite complicated and often involves case-by-case review. What rule should be applied to program decision to take "Brad" from one record and "Pitt" from other? What if data for the same email were: Brad Pitt and Bradley Pitt? Which is correct and should be saved? Probably have to do a query that finds duplicate emails in Staging and make case-by-case decision on what to fix/delete for these duplicates. Then insert to Contacts. Insert code can test content of each field for Null or False and determine whether to accept new value.
For non-yes/no field, use Nz() function (assumes text field will not have empty string)
myR2![First Name] = Nz(myR2![First Name], myR![First Name])
or (to deal with possible empty string)
If myR2![First Name] & "" = "" Then myR2![First Name] = myR![First Name]
(advise not to allow empty string in text field nor zero default value for number field in table design).
For yes/no field, test for False (do not set DefaultValue property in table design):
myR2![Supress] = IIf(myR2![Supress] = False, myR![Supress], True)
or
If myR2![Supress] = False Then myR2![Supress] = myR![Supress]
Shorter code for import procedure. Modify with the above.
Do Until myR.EOF = True
myR2.FindFirst ("Email = '" & myR![Email] & "'")
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
myR2![First Name] = myR![First Name]
myR2![Last Name] = myR![Last Name]
myR2![Position] = myR![Position]
myR2![Company] = myR![Company]
myR2![Industry] = myR![Industry]
myR2![Size] = myR![Size]
myR2![WebSite] = myR![WebSite]
myR2![Location] = myR![Location]
myR2![Office Number] = myR![Office Number]
myR2![Mobile Number] = myR![Mobile Number]
myR2![Source] = myR![Source]
myR2![CFO-DEL] = myR![CFO-DEL]
myR2![CFO-SPON] = myR![CFO-SPON]
myR2![DP-DEL] = myR![DP-DEL]
myR2![DP-SPON] = myR![DP-SPON]
myR2![HR-DEL] = myR![HR-DEL]
myR2![HR-SPON] = myR![HR-SPON]
myR2![CIO-DEL] = myR![CIO-DEL]
myR2![CIO-SPON] = myR![CIO-SPON]
myR2![CMO-DEL] = myR![CMO-DEL]
myR2![CMO-SPON] = myR![CMO-SPON]
myR2![CISO-DEL] = myR![CISO-DEL]
myR2![CISO-SPON] = myR![CISO-SPON]
myR2![NIS] = myR![NIS]
myR2![Supress] = myR![Supress]
myR2.Update
myR.MoveNext
Loop
Another, assuming recordsets have exactly same fields.
Dim myR As DAO.Recordset
Dim myR2 As DAO.Recordset
Dim fld As DAO.Field
Set myR = CurrentDb.OpenRecordset("Staging - Import", dbOpenDynaset)
Set myR2 = CurrentDb.OpenRecordset("Contacts", dbOpenDynaset)
Do Until myR.EOF = True
myR2.FindFirst "Email = '" & myR![Email] & "'"
If myR2.NoMatch = True Then
myR2.AddNew
myR2![Email] = myR![Email]
Else
myR2.Edit
End If
For Each fld In myR.Fields
If fld.Name <> "Email" And _
(myR2.Fields(fld.Name) & "" = "" Or myR2.Fields(fld.Name) = False) Then
myR2.Fields(fld.Name) = fld
End If
Next
myR2.Update
myR.MoveNext
Loop

Update previous row

I have an Excel file that contains some datas that I want to export into an Access db. In the C column I've got a field called 'Description'. Usually this field occupy just one cell, but it can happens that is more long.
In this case, for example, AP.01 has got 5 rows of description. How can update the first row with the next rows?
Public Sub updateDB(ByVal PathDB As String, str As String, id As Integer)
Dim db As New cDB
Dim v As New cVoce
Dim rs As ADODB.Recordset = db.RecordSet
v.Description = str
db.connetti_DB(PathDB)
db.get_rs("UPDATE Voice SET Description = '" + v.Description + "' WHERE id= '"+id+"'")
End Sub
Public Function get_rs(ByVal query As String) As ADODB.Recordset
If db Is Nothing Then rs = Nothing : Return rs
rs = New ADODB.Recordset
rs.CursorType = ADODB.CursorTypeEnum.adOpenStatic
rs.LockType = ADODB.LockTypeEnum.adLockOptimistic
rs.Open(query, db)
Return rs
End Function
This code doesn't work because I update my current row, for this reason is useless the UPDATE instruction. How can I fix my code?
EDIT I post here the For loop
For r = 2 To grid.RowCount - 1
vett = Split(grid(r, 1).Text)
total = UBound(Split(grid(r, 1).Text, "."))
If grid(r, 1).Text <> "" Then
Select Case total
Case 0
Dim chapter As New cChapter
flag = 1
id = id + 1
chapter.Cod = grid(r, 1).Text.Substring(0, 1)
chapter.Description = grid(r, 3).Text
If Left(vett(0), 1) >= Chr(65) And Left(vett(0), 1) <= Chr(90) Then
chapter.Cod = Left(vett(0), 1)
oldChap = chap.Cod
If chapter.Cod <> oldCap Then
chapters.Add(chapter)
End If
End If
chapters.Add(chapter)
stringChap = chap.Description
Dim par As New cParagraph
If Left(vett(0), 2) >= Chr(65) And Left(vett(0), 2) <= Chr(90) Then
par.Cod = Left(vett(0), 2)
par.Cod_Chapter = Left(vett(0), 1)
oldPar = par.Cod
If par.Cod <> oldPar Then
paragraphs.Add(par)
End If
End If
If grid(r, 3).Text.Length > 255 Then
par.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
par.Description = grid(r, 3).Text.ToString
End If
paragraphs.Add(par)
stringPar = par.Description
Case 1
flag = 2
id = id + 1
c_Voc = voc.Cod_Chapter
p_Voc = voc.Cod_Paragraph
voc.Cod_Chapter = grid(r, 1).Text.Substring(0, 1)
voc.Cod_Paragraph = grid(r, 1).Text.Split(".")(0)
voc.Cod_Voice = Right(vett(0), 2)
If grid(r, 3).Text.Length > 255 Then
voc.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
voc.Description = grid(r, 3).Text.ToString
If voc.Description.EndsWith("-") Then
a = Replace(voc.Description, "-", "")
voc.Description = a
End If
End If
stringVoice = voc.Description
voices.Add(voc)
voices.Save_DB(dbDest)
Case 2
flag = 3
id = id + 1
sVoice = New cVoice
oldSvoice = voice.Cod_SVoice
sVoice.Cod_SVoice = Left(vett(0), 2)
If sVoice.Cod_SVoce <> oldSvoice Then
voices.Add(sVoice)
voices.Save_DB(dbDest)
End If
If grid(r, 3).Text.Length > 255 Then
sVoice.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
sVoice.Description = grid(r, 3).Text
End If
stringSvoice = sVoice.Description
sVoice.Cod_Voce = Left(vett(0), 5)
sVoice.Price1 = grid(r, 12).Text
sVoice.Price2 = sVoice.Price1
sVoice.UniMi = grid(r, 11).Text
sVoce.Sep = "."
voices.Add(sVoce)
voices.Save_DB(dbDest)
End Select
Else
If flag = 1 Then
stringChap = grid(r, 3).Text
chap.Description = stringChap & grid(r, 3).Text
stringPar = grid(r, 3).Text
paragraph.Description = stringPar & grid(r, 3).Text
End If
If flag = 2 Then
stringVoice = grid(r, 3).Text
voc.Description = voc.Description & stringVoice
voices.updateDB(dbDest, stringVoice, id)
voices.Add(voc)
End If
If flag = 3 Then
stringSvoice = grid(r, 3).Text
sVoice.Description = stringSvoice & grid(r, 3).Text
voices.Add(sVoice)
End If
chapter.Save_DB(dbDest)
paragraph.Save_DB(dbDest)
voice.Save_DB(dbDest)
End If
Next
EDIT2 I declared id As Integer and when Code column has a value then id=id+1. In this way I always know which row I have to modify. I modified also updateDB (now I'm using 3 parameters) and I added a WHERE condition into my query. Despite the update, nothing has changed
In database you cannot store records without PrimaryKey (actually you can, but it is bad idea). Since in your solution id is in fact Excel row number (sorry if I'm not correct but it looks like from code) it could be very hard to maintain it in future (in case someone add or remove description row). It would be better to change id column to text and use code as PK.
Storing description then could be solved in 2 ways:
1) Concatenate all rows containing description into 1 variable adding vbNewLine in between and store it in description field.
2) More relational but also more complex - create 2nd table for description with PK as i.e. autonumber, ForeignKey Code referring to main table. Maintenance will be here very complex. Not really worth effort.
Amount of changes in code is quite big, so sorry I'll not provide fixed code but I hope idea is clear.
BTW: The reason why description is not updated is described in your post. You are increasing id only when code is present, so every description field from first group have id = 1. The most simple fix in your code would be to create 2 update statements - One for rows with code
UPDATE Voice SET Description = '" + v.Description + "' WHERE id= '"+id+"'
Second one for rows without code:
UPDATE Voice SET Description = Description + CHAR(13) + CHAR(10) + '" + v.Description + "' WHERE id= '"+id+"'

Insert multiple records with multiple tables having the same ID into a table using DAO in Access

(1) I have 4 tables (A-Sched,B-Trans,(C-ItemRecep and D-ItemPharm)) with one Lookup table called D-TransDetail. Below is the relationship diagram and the DAO record set for storing records.
Public Sub RecpSchedule1()
'Consultation ONLY
Dim db As DAO.Database
Dim rs As DAO.Recordset, rt As DAO.Recordset, rd As DAO.Recordset, ri As DAO.Recordset
Dim lngTransId As Long
Dim lngItemRecepId As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("Sched")
Set rt = db.OpenRecordset("Trans")
Set ri = db.OpenRecordset("ItemRecep")
Set rd = db.OpenRecordset("TransDetail")
lngItemRecepId = Nz(DMax("ID", "ItemRecep"), 0) + 1 'Next ItemRecep ID
lngTransId = Nz(DMax("ID", "Trans"), 0) + 1 'Next Trans ID
With rs
.AddNew
!SDate = Me.txtSchedDate
!PatientName = Me.cmbPatientName
!RegNo = Me.txtRegNo
!DateOfBirth = Me.txtAge
!Gender = Me.txtGender
!PatientClass = Me.PatientClass
!RecepSchedule = True
.Update
End With
With rt
.AddNew
!ID = lngTransId
!SchedRegNo = Me.txtRegNo
![Total_RecepFee] = Me.txtConsFee + ![Total_RecepFee]
.Update
End With
With ri
.AddNew
!ID = lngItemRecepId
!ItemName = "ConsFee"
!Price = Me.txtConsFee.Value
!Dept = "Reception"
.Update
End With
With rd
.AddNew
!TransID = lngTransId
!TransID = DMax("ID", "Trans")
!ItemRecepID = DMax("ID", "ItemRecep")
.Update
End With
rs.Close
rt.Close
ri.Close
rd.Close
Set rs = Nothing
Set rt = Nothing
Set rd = Nothing
Set ri = Nothing
Set db = Nothing
End Sub
Public Sub RecpSchedule2()
Dim db As DAO.Database
Dim rs As DAO.Recordset, rt As DAO.Recordset, rd As DAO.Recordset, ri As DAO.Recordset
Dim lngTransId As Long
Dim lngItemRecepId As Long
Set db = CurrentDb
Set rt = db.OpenRecordset("Trans")
Set ri = db.OpenRecordset("ItemRecep")
Set rd = db.OpenRecordset("TransDetail")
lngItemRecepId = Nz(DMax("ID", "ItemRecep"), 0) + 1 'Next ItemRecep ID
lngTransId = Nz(DMax("ID", "Trans"), 0) + 1 'Next Trans ID
With ri
.AddNew
!ID = lngItemRecepId
!ItemName = "IOPFee"
!Price = Me.txtIOPFee.Value
!Dept = "Reception"
.Update
End With
With rd
.AddNew
!TransID = lngTransId
!TransID = DMax("ID", "Trans")
!ItemRecepID = DMax("ID", "ItemRecep")
.Update
End With
rt.Close
ri.Close
rd.Close
Set rt = Nothing
Set rd = Nothing
Set ri = Nothing
Set db = Nothing
End Sub
(2) I created 2 Queries ("TransQry" and "SubTransQry") from the tables above.
(3) Finally I created a parent form (frmAccount)containing a child "TransForm" which also Parents it's own child "SubTransForm".
This model works perfect when it is only "ItemRecep"(Table C), but the subforms were not reporting correctly on the parent form the moment I introduce the new "ItemPharm"(Table D).
I expected the form to display a new subform transaction Itempharm. (with diff ID i.e 4) containing it's own sub items with Price subtotal. And the Grand Total from the figure above adding up the 2 sub totals.
P.S -Please let me know if my explanation is not understood, I am ready to provide more information
The solution is in the query below:
SELECT DISTINCT Sched.RegNo
,Sched.PatientName
,Sched.DateOfBirth
,Sched.Gender
,Sched.PatientClass
,Sum(ItemRecep.Price) AS SumOfPrice
,Sched.SDate
,Trans.PDate
,Avg(Sched.TotalDiscount) AS AvgOfTotalDiscount
,Sum([ItemRecep] ! [Price]) - Avg([Sched] ! [AmtPaid]) AS Bal
,Avg(Sched.AmtPaid) AS AvgOfAmtPaid
,Trans.RecepTotalPayStatus
,Sum(Trans.Total_PharmFee) AS SumOfTotal_PharmFee
,Sum(Trans.Total_PharmPay) AS SumOfTotal_PharmPay
,Sum(Trans.Pharm_Discount) AS SumOfPharm_Discount
,Sum(Trans.Total_PharmBal) AS SumOfTotal_PharmBal
,Trans.PharmTotalPayStatus
,Sum(Trans.Total_OpticalFee) AS SumOfTotal_OpticalFee
,Sum(Trans.Total_OpticalPay) AS SumOfTotal_OpticalPay
,Sum(Trans.Optical_Discount) AS SumOfOptical_Discount
,Sum(Trans.Total_OpticalBal) AS SumOfTotal_OpticalBal
,Trans.OpticalTotalPayStatus
,Sum(Trans.Total_LabFee) AS SumOfTotal_LabFee
,Sum(Trans.Total_LabPay) AS SumOfTotal_LabPay
,Sum(Trans.Lab_Discount) AS SumOfLab_Discount
,Sum(Trans.Total_LabBal) AS SumOfTotal_LabBal
,Trans.LabTotalPayStatus
,Sum(Trans.Total_SurgeryFee) AS SumOfTotal_SurgeryFee
,Sum(Trans.Total_SurgeryPay) AS SumOfTotal_SurgeryPay
,Sum(Trans.Surgery_Discount) AS SumOfSurgery_Discount
,Sum(Trans.Total_SurgeryBal) AS SumOfTotal_SurgeryBal
,Trans.SurgeryTotalPayStatus
,Sum(Trans.Grand_TotalFee) AS SumOfGrand_TotalFee
,Sum(Trans.Grand_TotalPay) AS SumOfGrand_TotalPay
,Sum(Trans.Grand_TotalDiscount) AS SumOfGrand_TotalDiscount
,Sum(Trans.Grand_TotalBal) AS SumOfGrand_TotalBal
,Trans.Grand_TotalPayStatus
FROM (
Sched INNER JOIN Trans ON Sched.RegNo = Trans.SchedRegNo
)
INNER JOIN (
ItemRecep INNER JOIN TransDetailRecep ON ItemRecep.ID = TransDetailRecep.ItemRecepID
) ON Trans.ID = TransDetailRecep.TransID
GROUP BY Sched.RegNo
,Sched.PatientName
,Sched.DateOfBirth
,Sched.Gender
,Sched.PatientClass
,Sched.SDate
,Trans.PDate
,Trans.RecepTotalPayStatus
,Trans.PharmTotalPayStatus
,Trans.OpticalTotalPayStatus
,Trans.LabTotalPayStatus
,Trans.SurgeryTotalPayStatus
,Trans.Grand_TotalPayStatus
HAVING (
((Sched.SDate) = DATE ())
AND ((Trans.RecepTotalPayStatus) = False)
)
ORDER BY Sched.PatientName;

Multidimensional array problem

I want to create a multidimensional array with 2 columns and have the row size a dynamic value. I then want to populate the multidimensional array with values from 2 different SQL queries (Microsoft).
The problem is That when the page loads it seems to be empty. How can Fill each column with he two different recordsets?
Or
At least return the total number of rows in the recordset?
Code below -
connectionstring = obj_ADO.getconnectionstring
Set objCon = CreateObject("ADODB.Connection")
Set objRS = CreateObject("ADODB.Recordset")
set objComm = CreateObject("ADODB.Command")
objCon.Open connectionstring
objComm.ActiveConnection = objCon.ConnectionString
objComm.CommandText = "A_Page_Paging"
objComm.CommandType = adCmdStoredProc
Set objParameter = objComm.CreateParameter
objParameter.Name = "selected_Char"
objParameter.Type = adChar
objParameter.Direction = adParamInput
objParameter.Size = 3
objParameter.Value = Selected_Button
objComm.Parameters.Append objParameter
set objRS = objComm.Execute
Increment = 0
Dim testArray()
while not objRS.EOF
Redim testArray(2, increment)
'--------------------------------------------
Page_ID = objRS("P_PageID")
connectionstring = obj_ADO.getconnectionstring
Set objConn = CreateObject("ADODB.Connection")
Set objRSS = CreateObject("ADODB.Recordset")
objConn.Open connectionstring
SQL = "Select P_Name as P_Name, P_Description as P_Description from L_PagePermission inner join A_Permission on p_permissionID = pp_PermissionID inner join A_Page on P_PageID = PP_PageID where P_PageID =" & Page_ID & " order by p_Name"
objRSS.open SQL, objConn
if not objRSS.EOF then
objRSS.MoveFirst
while not objRSS.EOF
'Fill Array
testArray(0, increment) = objRS("P_PageID")
objRSS.MoveNext
wend
objRSS.close
objConn.close
else
testArray(0, increment) = "-"
end if
Increment = Increment + 1
'--------------------------------------------
%>
<%
objRS.MoveNext
wend
objRS.Close
objCon.Close
response.Write testArray(0,5)
Figured it out myself by using preseve in the redim of my array so the code below fixed my problem -
'--------------------------------------------
Increment = 0
Dim testArray()
connectionstring = obj_ADO.getconnectionstring
Set objConn = CreateObject("ADODB.Connection")
Set objRSS = CreateObject("ADODB.Recordset")
objConn.Open connectionstring
SQL = "select * from a_permission inner join L_PagePermission on P_PermissionID = PP_PermissionID inner join A_Page on P_PageID = PP_PageID order by P_Name"
objRSS.open SQL, objConn
if not objRSS.EOF then
objRSS.MoveFirst
while not objRSS.EOF
Redim Preserve testArray(2, increment)
'Two Dimensional Array
testArray(0, increment) = objRSS("P_PageID")
testArray(1, increment) = objRSS("P_Name")
objRSS.MoveNext
Increment = Increment + 1
wend
objRSS.close
objConn.close
else
testArray(0, increment) = "-"
testArray(1, increment) = "-"
end if
'--------------------------------------------
'--------------------------------------------
Page_ID = objRS("P_PageID")
for i = 0 to (increment - 1)
if testArray(0, i) = Page_ID then
%>
<li style="" ="padding:0;margin:0;"><%=testArray(1,i)%></li>
<%
end if
next
'--------------------------------------------
If you run this query, do you get rows returned?
Select P_Name as P_Name, P_Description as P_Description from L_PagePermission inner join A_Permission on p_permissionID = pp_PermissionID inner join A_Page on P_PageID = PP_PageID where P_PageID =" & Page_ID & " order by p_Name

Automatic chart update with new data entry

My chart loads data from a DataGridView.
I want to automatically update my chart with new data if new values are inserted into the DataGridView.
My chart is bound to table1 and table2 in my DataGridView which gets values from a DataTable. Here is a small portion of the code:
Dim myData As New DataTable
wcAdapter.SelectCommand = wcCommand
wcAdapter.Fill(myData)
-
Chart1.DataSource = myData
Chart1.Series("Series1").ValueMemberX = "table1"
Chart1.Series("Series1").ValueMembersY = "table2"
Here is the complete code:
Try
wcconn.Open()
Dim wcCommand As New MySqlCommand()
''telesales name
' Dim wcQuery = "SELECT ID, Telesales, SUBSTRING(lastupdatedate, 1, 10) as 'Day', SUBSTRING(lastupdatetime FROM -9 FOR 6) as 'Time' FROM ratingout where Telesales='" & cbTelesales.Text & "' and lastupdatedate= '" & newDate & "' and lastupdatedate is not null and lastupdatetime is not null ORDER BY lastupdatetime ;"
' wcCommand.Connection = wcconn
' wcCommand.CommandText = wcQuery
Dim newDate As String
newDate = dateWorkCheck.Text
newDate = newDate.Replace("/", "-")
Dim y, m, d As String
y = newDate.Substring(6, 4)
m = newDate.Substring(3, 2)
d = newDate.Substring(0, 2)
newDate = y & "-" & m & "-" & d
Dim wcQuery = "SELECT ID, Telesales, lastupdatedate as 'Day', SUBSTRING(lastupdatetime FROM -8 FOR 2) as 'Time' FROM ratingout where Telesales='" & cbTelesales.Text & "' and lastupdatedate= '" & newDate & "' and lastupdatedate is not null and lastupdatetime is not null ORDER BY lastupdatetime ;"
wcCommand.Connection = wcconn
wcCommand.CommandText = wcQuery
Dim wcData As New DataTable
wcAdapter.SelectCommand = wcCommand
wcAdapter.Fill(wcData)
Dim i = 0
If wcData.Rows.Count = 0 Then
wcAdapter.Dispose()
Try
Dim wQuery = "SELECT ID, Telesales, lastupdatedate as 'Day', SUBSTRING(lastupdatetime FROM -8 FOR 2) as 'Time' FROM ratingout where Telesales='" & cbTelesales.Text & "' and lastupdatedate= '" & dateWorkCheck.Text & "' and lastupdatedate is not null and lastupdatetime is not null ORDER BY lastupdatetime ;"
wcCommand.Connection = wcconn
wcCommand.CommandText = wQuery
Dim wData As New DataTable
wcAdapter.SelectCommand = wcCommand
wcAdapter.Fill(wData)
wData.Columns.Add("tt")
wData.Columns.Add("num")
wcData.Columns.Add("tt")
wcData.Columns.Add("num")
'dgvWorkCheck.AutoSizeRowsMode = DataGridViewAutoSizeRowMode.AllCells
Dim dr As DataRow
For Each dr In wData.Rows
If lastV Is Nothing OrElse Not ColumnEqual(lastV, dr("Time")) Then
''check if first value is nothing
If lastV = Nothing Then
lastV = "00"
l = "0"
Else
dr("tt") = lastV
dr("num") = l
'wcData.Tables("ratingout").Rows(I)("ID") = dr("ID")
End If
ListBox1.Items.Add(lastV & " <--> " & l)
lastV = dr("Time")
l = 1
ElseIf lastV Is Nothing OrElse ColumnEqual(lastV, dr("Time")) Then
l += 1
'Dim series1 As New Series()
'series1.Points.Add(l)
End If
For I = I To wData.Rows.Count
If I <> wData.Rows.Count Then
I += 1
If i = wData.Rows.Count Then
dr("tt") = lastV
dr("num") = l
ListBox1.BeginUpdate()
ListBox1.Items.Add(dr("Telesales") & " between[" & lastV & " and 17:00, ] <--> " & l & "[ records ]")
ListBox1.EndUpdate()
End If
GoTo n
Else
MsgBox("last data")
End If
Next
n:
Next
txtRec.Text = wData.Rows.Count
dgvWorkCheck.DataSource = wData
''chart
Dim ChartArea2 As ChartArea = New ChartArea()
Dim Legend2 As Legend = New Legend()
Dim Series2 As Series = New Series()
Dim Chart2 = New Chart()
Me.Controls.Add(Chart2)
ChartArea2.AxisX.LabelStyle.Angle = -90
ChartArea2.AxisX.LabelStyle.Interval = 1
ChartArea2.AxisY.LabelStyle.Angle = -90
ChartArea2.AxisY.LabelStyle.Interval = 5
ChartArea2.Name = "ChartArea2"
Chart2.ChartAreas.Add(ChartArea2)
Legend2.Name = "Legend2"
Chart2.Legends.Add(Legend2)
Chart2.Location = New System.Drawing.Point(12, 113)
Chart2.Name = "Chart2"
Series2.ChartArea = "ChartArea2"
Series2.Legend = "Legend2"
Series2.Name = "Series2"
Chart2.Series.Add(Series2)
Chart2.Size = New System.Drawing.Size(1145, 604)
Chart2.TabIndex = 0
Chart2.Text = "Chart2"
Chart2.Series("Series2").XValueMember = "tt"
Chart2.Series("Series2").YValueMembers = "num"
Chart2.DataSource = dgvWorkCheck.DataSource
Chart2.DataBind()
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Exit Try
since the new data is inserted into a database, you will only need to rebind the gridview to it's source in order to display the new incoming data.
You should isolate the code that binds data to your chart in a function and have it called every time a new field gets inserted:
Function FillChartWithData()
Dim myData As New DataTable
wcAdapter.SelectCommand = wcCommand
wcAdapter.Fill(myData)
...
Chart1.Series("Series1").ValueMemberX = "table1"
Chart1.Series("Series1").ValueMembersY = "table2"
End Function
EDIT
I looked at your coded and it seems you're missing the part responsible for inserting new data inside the 'ratingout' table. You should create a function that allows you to insert new data, something along the line of:
Dim insertRating = "INSERT INTO ratingout VALUES (#NewTeleSalesName, #NewDate);"
Dim insertCmd As New MySqlCommand(insertRating, wcconn)
insertCmd.Parameters.Add("#NewTeleSalesName", MySqlDbType.VarChar, 255, "teleSalesName")
insertCmd.Parameters.Add("#NewDate", MySqlDbType.Datetime, 8, New DateTime(2010, 8, 5))
insertCmd.ExecuteNonQuery()
In order to update my chart bargraph named CashChart (which was databound to a BindingSource) I had to do the following:
To clear the chart information,
Clear the bounding source information
And then re-assign the bounding source information: for example:
CashChart.Series(0).Points.Clear()
CashChart.DataSource = ""
CashChart.DataSource = ESTADOINSTANTANEOBindingSource
Before, only my DataTable was updating, but after these commands, I was able to get the bargraph to update with new values in the table.