<code>
Private Sub CmbRNO_Click()
sql = "SELECT
A.ROLLNO,A.FIRST_NAME,A.MIDDLE_NAME,A.LAST_NAME,A.CONTACT,A.CONTACT1,A.CONTACT2,A.ADDRESS,A.GRADE,B.DIV,A.BLOOD_GROUP,C.HOUSE,A.DATE_OF_BIRTH,A.TRANSPORT,A.SNAME,A.MEAL,A.BUSNO,A.RUTNO,D.DNAME,D.DCONT,E.ANM,D.DADD,A.CARD_TYPE,A.CARD_NO
FROM
STUDENT_RECORD_DATABASE A,DIVISION B,HNM C,DRIVER D,ATTEND E
WHERE
A.DIVID=B.DIVID AND A.HID=C.HID AND A.DID=D.DID AND A.AID=E.AID AND ROLLNO ='" & CmbRNO.Text & "'"
Set RES = CON.Execute(sql)
TxtFNM.Text = RES!FIRST_NAME
TxtMIDNM.Text = RES!MIDDLE_NAME
TxtLNM.Text = RES!LAST_NAME
Text5.Text = RES!CONTACT
Text6.Text = RES!CONTACT1
Text7.Text = RES!CONTACT2
TxtADDR.Text = RES!ADDRESS
COMBO1.Text = RES!GRADE
CmbDIV.Text = RES!DIV
CmbBG.Text = RES!BLOOD_GROUP
CmbHOUSE.Text = RES!HOUSE
DTPicker1.Value = RES!DATE_OF_BIRTH //error showing
Combo10.Text = RES!TRANSPORT
CmbSTOP.Text = RES!SNAME
Combo11.Text = RES!MEAL
CmbBUS.Text = RES!BUSNO
Combo12.Text = RES!RUTNO
CmbDRIVER.Text = RES!DNAME
TxtDCONT.Text = RES!DCONT
CmbATTEND.Text = RES!ANM
Text10.Text = RES!DADD
Combo13.Text = RES!CARD_TYPE
Text11.Text = RES!CARD_NO
End If
End Sub
</code>
This is the full code to display student records on combo click
but error is: Invalid property value date_of_birth
Please help
This can be a result of difference in date format between oracle and vb6. To avoid that, I would explicitly define the date format while selecting the columns like this
SELECT
A.ROLLNO,
A.FIRST_NAME,
A.MIDDLE_NAME,
...
TO_CHAR(A.DATE_OF_BIRTH,'DD-MON-YYYY') DATE_OF_BIRTH
...
Then read it in VB6 by converting it into date:
DTPicker1.Value = CDate(RES!DATE_OF_BIRTH)
Related
I am looking for a VLOOKUP function that returns multiple values in the cell. Sometimes the column you are searching contains more than once the value.
For instance I have a list of products to import in Woocommerce, those products have variables and variations. I want to fill attributes cells of Variable with all its variation's attributes as a list. Then I search for ID in parent column and return the list of attributes.
Here is what I found.
'E2 = searchCell = SKU
'3 = columNumWhereToSearch = Parent
'6 = columnNumWhatToGet = Attribute
Function MULTIPLE_VLOOKUP(searchCell, columNumWhereToSearch, columnNumWhatToGet) As String
Dim Doc As Object
Dim Sheet As Object
Dim Cell As Object
Doc = ThisComponent
Sheet = Doc.Sheets(0)
Dim AttributeListString As String
AttributeListString = ""
'Set the number of row to search
For I = 1 To 150
CellToSearch = Sheet.getCellByPosition(columNumWhereToSearch, I)
If CellToSearch.String = searchCell then
CellToGetAndReturn = Sheet.getCellByPosition(columnNumWhatToGet, I).String
If Len(CellToGetAndReturn) > 0 And CellToGetAndReturn <> "Err:522" And CellToGetAndReturn <> "Err:508" And CellToGetAndReturn <> "#NAME?" And CellToGetAndReturn <> "#NULL!" And CellToGetAndReturn <> "#VALUE!" And CellToGetAndReturn <> "#REF!" then
If Len(AttributeListString ) > 0 then
AttributeListString = AttributeListString + ","
End If
AttributeListString = AttributeListString + CellToGetAndReturn
End If
End If
Next I
multiple_vlookup = AttributeListString
End Function
Use it like =MULTIPLE_VLOOKUP(E2;4;7)
I am trying to create a pivot table using VBScript. I think I am close to achieving it, but I do not know how to create the report filter and set up the filter for "Internal", or how to use sum instead of count in the values.
That is what I have now:
xlA1 = 1
xlDatabase = 1
xlRowField = 1
xlColumnField = 2
xlFilterField = 3
Set xlBook1 = objExcel.WorkBooks.Open(ws_path & "FINAL.xlsx")
set rngData =xlBook1.Sheets("NONPO").Usedrange
set rngReport = xlBook1.Sheets("NONPO").Range("CE1")
set pvtCache = xlBook1.pivotCaches.add(xlDatabase, rngData.address(true, true, xlA1, true))
set pvtTable = pvtCache.createPivotTable(rngReport, "Pivot1")
pvtTable.pivotFields("Date").orientation =xlRowField
pvtTable.pivotFields("Country Code").orientation = xlColumnField
pvtTable.pivotFields("Agent Type").orientation = xlFilterField
'*****Here I should Use filter as "Internal"*****
pvtTable.pivotFields("Hours").orientation = xlsum *****xlsum is not working*****
should work like this...
With pvtTable.pivotFields("Hours")
.orientation = 4
.Function = xlSum
End With
I believe this is what you want.
pt.AddDataField(pt.PivotFields("Hours"), "Hours", _
Excel.XlConsolidationFunction.xlSum)
So, the whole thing should look kind of like this (modify for your specific needs).
Private Sub CreatePivotTable(tableName As String)
Dim targetSheet As Excel.Worksheet = ExcelApp.Sheets.Add
Dim ptName As String = "MyPivotTable"
'We'll assume the passed table name exists in the ActiveWorkbook
targetSheet.PivotTableWizard(Excel.XlPivotTableSourceType.xlDatabase, _
tableName, targetSheet.Range("A5"))
targetSheet.Select()
Dim pt As Excel.PivotTable = targetSheet.PivotTables(1)
'To be professional or merely resuable, the name could be passed as parameter
With pt.PivotFields("Order Date")
.Orientation = Excel.XlPivotFieldOrientation.xlRowField
.Position = 1
End With
pt.AddDataField(pt.PivotFields("Order Total"), "Order Count", _
Excel.XlConsolidationFunction.xlCount)
pt.AddDataField(pt.PivotFields("Order Total"), "Total for Date", _
Excel.XlConsolidationFunction.xlSum)
'--OR--
'AddPivotFields(pt, "Order Total", "Order Count", _
' Excel.XlConsolidationFunction.xlCount)
'AddPivotFields(pt, "Order Total", "Total For Date", _
' Excel.XlConsolidationFunction.xlSum)
Marshal.ReleaseComObject(pt)
Marshal.ReleaseComObject(targetSheet)
End Sub
Using VB 6 and adodb connection, when I click search for id, a inputbox will appear, when it finds The id I wanted, it will automatically insert all the data of that row to their corresponding textboxes.
Here my code, at somepoint, it does not work, I dont remember the error but I will post it here when I get home, thanks for your help guys.
Private Sub cmdsearch_Click()
findemployee = InputBox("Insert Employee ID")
record.Open ("select * from employees where ID='" & findemployee & "'"), conn, 3, 3
If record.EOF Then
MsgBox "NO" & findemployee & " ID WAS NOT FOUND!", vbCritical + vbOKOnly, "Error Search"
Set record = Nothing
Else
txtemployeeid.Text = record!ID
txtlnames.Text = record!lastname
txtfnames.Text = record!Firstname
txtmnames.Text = record!middlename
cmbgenders.Text = record!gender
bdates.Value = record!birthdate
txtbplaces = record!birthplace
txtages = record!age
txtaddress.Text = record!address
cmbeducattainments.Text = record!educattainment
txtnos.Text = record!contactno
cstarts.Value = record!contractstart
cends.Value = record!contractend
Set record = Nothing
End If
End Sub
Private Sub cmdsearch_Click()
findemployee = inputtextbox.text
record.Open ("select * from employees where ID='" & findemployee & "'"), conn, 3, 3
If record.EOF Then
MsgBox "NO" & findemployee & " ID WAS NOT FOUND!", vbCritical + vbOKOnly, "Error Search"
Set record = Nothing
Else
with record
txtemployeeid.Text = !ID
txtlnames.Text = !lastname
txtfnames.Text = !Firstname
txtmnames.Text = !middlename
cmbgenders.Text = !gender
bdates.Value = !birthdate
txtbplaces = !birthplace
txtages = !age
txtaddress.Text = !address
cmbeducattainments.Text = !educattainment
txtnos.Text = !contactno
cstarts.Value = !contractstart
cends.Value = !contractend
Set record = Nothing
END WITH
End If
End Sub
Dim srch As String
srch = ccode.Text
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + IO.Directory.GetCurrentDirectory + "\ptdr.accdb"
cmd.Connection = conn
conn.Open()
Dim dsrch As New OleDbCommand("SELECT pname, page, vdate, psex, summer, bldp, blds, photh, diag, rl, trtmnt, nvdate FROM ptnt_data WHERE pcode = " & srch & "", conn)
Dim rdr As OleDbDataReader = dsrch.ExecuteReader()
Dim dg As String = ""
'diagnosis'
dg = rdr.GetString(8).ToString()
If String.IsNullOrEmpty(dg) Then
diag1.Text = ""
ElseIf String.IsNullOrWhiteSpace(dg) Then
diag1.Text = ""
Else
diag1.Text = dg
End If
It works fine but when I search for a null it gives an error.
It says that I've an error at the line of
dg = rdr.GetString(8).Tostring()
any suggests?
rdr.GetString(8).ToString()
if rdr.GetString(8) is null this is a classic null reference exception
rdr.GetString(8) IS a string so just remove the .ToString()
As per my comment below you can only run GetString if the DB has an underlying type of string for this data, what is the datatype of column diag?
(ie run rdr.GetFieldType(8) in the debugger and provide the type name)
As you have confirmed this is a string type and the issue is just with null handling (sorry i didn;t spot that from your question) you need:
If rdr.IsDBNull(8) Then diag1.Text = "" Else diag1.Text = rdr.GetString(8) EndIf
Which should replace everything from Dim dg... down
I am using the htmlagilitypack to parse an xml document. I use it to load the string as a htmldocument and then use the xmltextreader to parse. I will occasionally get an unhandled stackoverflow exception on htmlagility.dll.
The specific line is
internal Dictionary<string, Htmlattribute> Hashitems = new
Dictionary<string, HtmlAttribute>()
EDIT:
Try
Dim hdoc = New HtmlAgilityPack.HtmlDocument()
hdoc.LoadHtml(xmlsnippet)
Dim nreader As XmlTextReader = New
XmlTextReader(New StringReader(xmlsnippet))
Dim ncount As Integer = 0
While nreader.Read
If Not nreader.Name = "" Then
ncount += 1
If ncount = 18 Then
Exit While
End If
num += 1
nodelist.Add(nreader.Name)
If nreader.Name = "id" Then
statid = nreader.ReadInnerXml
End If
If nreader.Name = "published" Then
contentDate = nreader.ReadInnerXml
contentDate = Regex.Replace(contentDate, "T", " ")
contentDate = Regex.Replace(contentDate, "\+", " ")
contentDate = contentDate.Replace("Z", "")
End If
If nreader.Name = "summary" Then
ctext = nreader.ReadInnerXml
End If
If nreader.Name = "title" Then
csubject = nreader.ReadInnerXml
If csubject.Contains("posted") Then
template = csubject
author = Regex.Replace(template, "posted.*", "")
End If
If csubject.Contains("Keyword -") Then
Dim tip As String = csubject
searchterm =
Regex.Replace(csubject, "xxxxxx.*xxxxxx.*xxxx.*-", "")
searchterm =
Regex.Replace(searchterm, "xxxxx.*xxxxxx.*Search.*-", "")
Trim(searchterm)
End If
End If
End If
End While
Dim mreader As XmlTextReader =
New XmlTextReader(New StringReader(xmlsnippet))
Dim mcount As Integer = 0
While mreader.Read
If Not mreader.Name = "" Then
mcount += 1
If mcount > 15 Then
If mreader.Name = "uri" Then
authorUri = mreader.ReadInnerXml
Trim(authorUri)
If authorUri = "http://www.xxxxxxxx.com/" Then
authorUri = ""
End If
End If
If mreader.Name = "name" Then
author = mreader.ReadInnerXml
If author = "xxxxxx" Then
author = ""
End If
End If
If mreader.Name = "content" Then
htext = mreader.ReadInnerXml
End If
If mreader.Name = "link" Then
Dim address As String
address = mreader.ReadOuterXml
If address.Contains("related") Then
Dim regex12 As Regex =
New Regex("<link.*rel.*href=""(?<Link>.*?)"".*/>", RegexOptions.IgnoreCase)
Dim m12 As Match = regex12.Match(address)
himage = m12.Groups("Link").Value
ElseIf address.Contains("alternate") Then
Dim regex13 As Regex =
New Regex("<link.*rel.*href=""(?<Link>.*?)"".*/>", RegexOptions.IgnoreCase)
Dim m13 As Match = regex13.Match(address)
authorUri = m13.Groups("Link").Value
End If
End If
If mreader.Name = "subtitle" Then
hsubtitle = mreader.ReadInnerXml
End If
End If
End If
End While
Catch ex As Exception
appLogs.constructLog(ex.Message.ToString, True, True)
Exit Sub
End Try
In fact there are different stackoverflow exception errors occurring at different lines but the same error and only while using htmlagilitypack. I am in another method trying to parse the xml using xmldocument, xpathnavigator and it works fine unless I get some bad xml, then I go to this method. I have set up exception catches to just move the bad xml to a folder and then exit this method but I cannot catch these kinds of exceptions or can I?
Another line where error shows:
public string Name
{
get
{
if (_name == null)
{
Name = _ownerdocument.Text.Substring(_namestartindex, _namelength);
}
return _name != null ? _name.ToLower() : string.Empty;
on the last line in the snippet above in the file HtmlNode.cs.
The call stack window shows the top as
HtmlAgilityPack.dll!HtmlAgilityPack.HtmlNode.Name.get() Line 432 + 0x21 bytes