My goal is to run simple queries from LibreOffice Calc and get the results from a remote PostgreSQL database.
I tried to do something similar to this answer but I get an error.
Here is what I have:
Sub GetQuery
Dim oParms(1) as new com.sun.star.beans.PropertyValue
Dim oStatement As Object
Dim oResult As Object
Dim oConnection As Object
oParms(0).Name = "user"
oParms(0).Value = "serveruser"
oParms(1).Name = "password"
oParms(1).Value = "serverpwd"
oManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
sURL = "dbname=mydatabase hostaddr=X.X.X.X port=5432 user=postgresuser password=postgrespwd"
oConnection = oManager.getConnectionWithInfo(sURL, oParms())
oStatement = oConnection.createStatement()
oResult = oStatement.executeQuery("select count(*) from mytable")
MsgBox "Result: " & oResult
oStatement.close()
End Sub
When I try to run this I get "Object variable not set" on line oStatement = oConnection.createStatement().
As you can see I have very limited experience on remote database connection.
Related
I have a an unbound form that with a button that adds new record to a table. It is perfectly working but, now i want to use a sub function (newAddition) that handles the real work and just call it whenever i need but i discover that it is only showing blank fields in the main table when i try to save a new record.
Private Sub Command0_Click()
Dim db As Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("T_MASTER")
Dim Checker As Integer
Dim Duplicate_Checker As Integer
Dim code, prodname, QP1_combo, QP1_name, QP1_CAS, txt_component_Type, txt_CONTENT_Lower_limit, BEARBEITER As String
Dim CONTENT, Informationsquelle, Anzahl_Partner, Anhange, Kommentar, end_datum, datum_kunde, datum_dossier, compedium As Variant
Dim CONTENT_Upper_limit, Bearb_Start_Partner, Bearb_End_Partner, profile As Variant
Dim Date_of_entry, Bearb_Start_Datum, Bearb_End_Datum As Variant
Checker = 0
Duplicate_Checker = 0
'*******************************************************
'Verify that the essential fields have values.
'*******************************************************
If IsNull(Me.txt_code.Value) Then
Checker = MsgBox("Product code cannot be empty", vbOKOnly, "Error")
Me.txt_code.SetFocus
ElseIf IsNull(Me.txt_prodname.Value) Then
Checker = MsgBox("Please enter the product name", vbOKOnly, "Error")
Me.txt_prodname.SetFocus
ElseIf IsNull(Me.txt_QP1_combo.Value) Then
Checker = MsgBox("Please select PURE QP1.", vbOKOnly, "Error")
Me.txt_QP1_combo.SetFocus
ElseIf IsNull(Me.txt_component_Type.Value) Then
Checker = MsgBox("Please select the component type.", vbOKOnly, "Error")
Me.txt_component_Type.SetFocus
ElseIf IsNull(Me.txt_BEARBEITER.Value) Then
Checker = MsgBox("Please fill the bearbeiter field.", vbOKOnly, "Error")
Me.txt_BEARBEITER.SetFocus
End If
'*******************************************************
'Checking for duplicacies in the database.
'*******************************************************
code = Me.txt_code.Value
QP1_combo = Me.txt_QP1_combo.Value
If Checker = 0 Then
Do While Not rs.EOF
If rs("PRODUCT_CODE") = code And rs("PURE_QP1") = QP1_combo Then
Duplicate_Checker = MsgBox("Record already in the database!", vbOKOnly, "Duplicate")
End If
rs.MoveNext
Loop
End If
'*******************************************************
' Reading the values.
'*******************************************************
If Checker = 0 And Duplicate_Checker = 0 Then
prodname = Me.txt_prodname.Value
QP1_name = Me.txt_QP1_name.Value
QP1_CAS = Me.txt_QP1_CAS.Value
Component_Type = Me.txt_component_Type.Value
CONTENT = Me.txt_content.Value
CONTENT_Lower_limit = Me.txt_CONTENT_Lower_limit.Value
CONTENT_Upper_limit = Me.txt_CONTENT_upper_limit.Value
'Date_of_entry = Me.txt_Date_of_entry.Value
BEARBEITER = Me.txt_BEARBEITER.Value
Bearb_Start_Datum = Me.txt_Bearb_Start_Datum.Value
Bearb_Start_Partner = Me.txt_Bearb_Start_Partner.Value
Bearb_End_Datum = Me.txt_Bearb_End_Datum.Value
Bearb_End_Partner = Me.txt_Bearb_End_Partner.Value
Anzahl_Partner = Me.txt_Anzahl_Partner.Value
Informationsquelle = Me.txt_Informationsquelle.Value
Anhange = Me.txt_Anhange.Value
Kommentar = Me.txt_Kommentar.Value
datum_kunde = Me.txt_datum_kunde.Value
datum_dossier = Me.txt_datum_dossier.Value
profile = Me.txt_profile.Value
compedium = Me.txt_compedium.Value
'*******************************************************
'Updating the database.
'*******************************************************
NewAddition
MsgBox ("Record successfully saved")
End If
End Sub`
And this is the sub function
Sub NewAddition()
Dim db As Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("T_MASTER")
rs.AddNew
rs("PRODUCT_CODE") = code
rs("PRODUCT_NAME") = prodname
rs("PURE_QP1").Value = QP1_combo
rs("PURE_NAME_QP1").Value = QP1_name
rs("PURE_CAS_NR").Value = QP1_CAS
rs("Component_Type").Value = Component_Type
rs("CONTENT").Value = CONTENT
rs("CONTENT_lower limit").Value = CONTENT_Lower_limit
rs("CONTENT_upper limit").Value = CONTENT_Upper_limit
rs("Date_of_entry").Value = Date
rs("BEARBEITER").Value = BEARBEITER
rs("Bearb_Start_Datum").Value = Bearb_Start_Datum
rs("Bearb_Start_Partner").Value = Bearb_Start_Partner
rs("Bearb_End_Datum").Value = Bearb_End_Datum
rs("Bearb_End_Partner").Value = Bearb_End_Partner
rs("Anzahl_Partner").Value = Anzahl_Partner
rs("Informationsquelle").Value = Informationsquelle
rs("Anhänge").Value = Anhange
rs("Kommentar").Value = Kommentar
rs("Datum_Statement_Kunde").Value = datum_kunde
rs("Datum_Statement_Dossier").Value = datum_dossier
rs("Profile_Y_N").Value = profile
rs("Compendium_Y_N").Value = compedium
' rs("Thema").Value = topic
rs.Update
End Sub
If i click the button, it brings the prompt, record successfully saved as in the code but doesn't write anyting there. It only creates blank records.
Variables are declared and set locally - they only exist for procedure they are declared in. They are killed when procedure ends. Need to declare variables in module header or use some other method to pass data to other procedure.
Option Compare Database
Option Explicit
Dim code, prodname, QP1_combo, QP1_name, QP1_CAS, txt_component_Type, txt_CONTENT_Lower_limit, BEARBEITER As String
Dim CONTENT, Informationsquelle, Anzahl_Partner, Anhange, Kommentar, end_datum, datum_kunde, datum_dossier, compedium As Variant
Dim CONTENT_Upper_limit, Bearb_Start_Partner, Bearb_End_Partner, profile As Variant
Dim Date_of_entry, Bearb_Start_Datum, Bearb_End_Datum As Variant
__________________________________________________________________________________
Private Sub Command0_Click()
...
VBA requires every variable type to be explicitly declared or it will default to Variant. So on line where you have BEARBEITER As String, only BEARBEITER is a string type, others on that line are Variant. They will work regardless.
I am trying to retrieve the email address for a known Active Directory user by using their login ID and the DirectorySearcher.FindOne() method in VB.Net but I have been unable to get any results.
Sorry but I am new to VB.Net and do not know where I am going wrong. I have tried using various examples that I have found on the net but they all are in C#. I have been able to convert the code to VB but I am still not able to pull results using what I have found. In the latest example I found here! it is using the FindAll() method and putting the results in a SearchResultCollection object. The collection ended up with a count of 0 so I have tried using the FindOne() method and tried to put the result in a SearchResult object. This didn't work for me either.
Public Shared Sub RetrieveUser(ByVal username As String)
Dim propUsername As String = "samaccountname"
Dim propFirstName As String = "givenName"
Dim propLastName As String = "sn"
Dim propDisplayName As String = "cn"
Dim propMail As String = "mail"
Dim propGuid As String = "objectguid"
Dim results As SearchResultCollection
Dim result As SearchResult
Dim directoryEntry As DirectoryEntry = New DirectoryEntry("LDAP_PATH", "DOMIAIN\USERNAME", "PASSWORD", AuthenticationTypes.ServerBind)
Using directorySearcher As DirectorySearcher = New DirectorySearcher(directoryEntry)
directorySearcher.PropertiesToLoad.Add(propUsername)
directorySearcher.PropertiesToLoad.Add(propDisplayName)
directorySearcher.PropertiesToLoad.Add(propFirstName)
directorySearcher.PropertiesToLoad.Add(propLastName)
directorySearcher.PropertiesToLoad.Add(propMail)
directorySearcher.PropertiesToLoad.Add(propGuid)
directorySearcher.Filter = String.Format("({0})", "&(objectClass=user)(cn=" & username & ")")
directorySearcher.SearchScope = SearchScope.Subtree
' directorySearcher.SearchRoot.AuthenticationType = AuthenticationTypes.Secure
directorySearcher.PageSize = 100
'results = directorySearcher.FindAll()
result = directorySearcher.FindOne()
'For Each result In results
If result.Properties.Contains(propUsername) Then
Console.WriteLine("User Name: " & result.Properties(propUsername)(0))
End If
If result.Properties.Contains(propGuid) Then
Console.WriteLine("User GUID: " & BitConverter.ToString(CType(result.Properties(propGuid)(0), Byte())).Replace("-", String.Empty))
End If
If result.Properties.Contains(propMail) Then
Console.WriteLine("Mail ID: " & result.Properties(propMail)(0))
End If
If result.Properties.Contains(propDisplayName) Then
Console.WriteLine("DisplayName: " & result.Properties(propDisplayName)(0))
End If
'Next
directorySearcher.Dispose()
directoryEntry.Dispose()
End Using
End Sub
How would I set following into array:
Public Function opcijeMp(ByVal hwid As String)
Dim hardware As String = hwid
Dim result = New List(Of String)()
Try
ManageConnection(False, konekcija) 'Open connection'
Dim strQuery As String = "SELECT * FROM info.opcije_mp as mp inner join instalacije as i where mp.idopcije_mp =
i.opcijeMP and i.instalacije_hwid = '" + Globals.cpuid + "';"
Dim SqlCmd As New MySqlCommand(strQuery, dbCon)
Dim reader As MySqlDataReader = SqlCmd.ExecuteReader()
While reader.Read()
Globals.prodaja = reader.GetString("Prodaja")
Globals.Kalkulacije = reader.GetString("Kalkulacije")
Globals.Zaduznice = reader.GetString("Zaduznice")
Globals.Predisponacije = reader.GetString("Predisponacije")
Globals.Robno = reader.GetString("Robno")
Globals.KUF = reader.GetString("KUF")
Globals.KIF = reader.GetString("KIF")
Globals.Narudzbenice = reader.GetString("Narudzbenice")
Globals.Nalozi = reader.GetString("Nalozi")
Globals.akcijskeCijene = reader.GetString("Akcijske_cijene")
Globals.servisnaRoba = reader.GetString("Servisna_roba")
Globals.Ostalo1 = reader.GetString("Ostalo1")
Globals.Ostalo2 = reader.GetString("Ostalo2")
Globals.Ostalo3 = reader.GetString("Ostalo3")
End While
reader.Close()
'Vraća podatke u Listi stringova
'Return result
Catch ex As MySqlException
Console.WriteLine("Error: " & ex.ToString())
Return Nothing
Finally
ManageConnection(True, konekcija)
End Try
End Function
So i can use it in next function with for each loop:
Dim s As String = Globals.prodaja
Dim parts As String() = s.Split(New Char() {","c})
Dim icona As String = parts(1)
Dim barmanager1 As New BarManager
Dim TileBarItem = New TileBarItem()
TileBarItem.Content = parts(3)
TileBarItem.Name = "ffss"
TileBarItem.Width = 150
Icon = New BitmapImage(New Uri("pack://application:,,,/DevExpress.Images.v16.1;component/Images/" + icona + ""))
TileBarItem.TileGlyph = Icon
TileBarItem.Background = New SolidColorBrush(DirectCast(ColorConverter.ConvertFromString(parts(2)), Color))
MessageBox.Show(parts(2))
maloprodaja.Items.Add(TileBarItem)
Right now i have to run function for each variable i have stored in global variables class, i would like to add all the results from first function to one array in Globals and then run second function with for each loop to populate my tilebar
Using an external variable like Globals to pass data around is extremely poor practice. Your first function in the question should return the data, or alternatively it should return the MySqlDataReader. That will simplify what you're trying to do later on and effectively make this problem go away.
I also so saw this:
Dim strQuery As String = "SELECT * FROM info.opcije_mp as mp inner join instalacije as i where mp.idopcije_mp =
i.opcijeMP and i.instalacije_hwid = '" + Globals.cpuid + "';"
I want to highlight this part:
" ... and i.instalacije_hwid = '" + Globals.cpuid + "';"
It's hard to understand just how bad that is. I can't think of a better way to get a program hacked. Google for parameterized queries and learn how to use them, rather than string concatentation, to put your cpuid into the sql statement.
I am logged into DC=domain,dc=company1,dc=com I am using VBA to query AD. I can query GC://dc=company1,dc=com with no issues. But when I try to query GC://dc=company2,dc=com I get no results. It appears that my code will not chase referrals.
I am able to run the queries using PowerShell so I know it should work. I just can't figure out how to get the VBA code to work so it chases referrals.
Here is the VBA code I am using that does not work. It just prints "not found" even though the same code does find something when using PowerShell.
Dim adConnection As ADODB.Connection
Dim adCommand As ADODB.Command
Dim adResults As ADODB.Recordset
Set adConnection = New ADODB.Connection
Set adCommand = New ADODB.Command
adConnection.ConnectionTimeout = 600
adConnection.Provider = "ADSDSOObject"
adConnection.Open "Active Directory Provider"
Set adCommand.ActiveConnection = adConnection
adCommand.Properties("Page Size") = 1000
adCommand.Properties("Size Limit") = 0
adCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
adCommand.Properties("Timeout") = 600
adCommand.Properties("Cache Results") = False
adCommand.Properties("Chase referrals") = ADS_CHASE_REFERRALS_ALWAYS
adCommand.CommandTimeout = 600
adCommand.CommandText = "<GC://dc=company2,dc=com>;(&(objectClass=user)(samAccountName=user1));samAccountName;Subtree"
Set adResults = adCommand.Execute
If Not adResults Is Nothing Then
If Not adResults.EOF Then
Debug.Print adResults.RecordCount
Else
Debug.Print "not found"
End If
adResults.Close
End If
Here is the PowerShell code that does work:
[System.DirectoryServices.DirectoryEntry] $objDERoot = New-Object System.DirectoryServices.DirectoryEntry("GC://dc=company2,dc=com")
[System.DirectoryServices.DirectorySearcher] $objSearcher = New-Object System.DirectoryServices.DirectorySearcher($objDERoot)
$objSearcher.SearchScope = "Subtree"
$objSearcher.ReferralChasing = "All"
$objSearcher.Filter = "(&(objectClass=user)(samAccountName=user1))"
$objSearcher.PropertiesToLoad.Add("samAccountName")
[System.DirectoryServices.SearchResultCollection] $colResults = $objSearcher.FindAll()
Foreach ($objResult in $colResults)
{
$objResult.Properties.Item("canonicalName")
}
I am having some problem with a function that I hope you can help.
My Application is a simple one, it uses an Access database to load employee information and creates letters and financial breakdown sheet from word templates that users can then print and save back to the database.
I started by creating a dataset containing several datatables for each form subroutine but it resulted in literally hundreds of lines of repeated code. But it worked.
What I want to do, is have one dataset containing all the information needed about an employee and be able to reference it over several forms at the same time. So i created a public module that looks like this:
Public Module Datasets
Public update As String
Dim pCn As OleDb.OleDbConnection
Public Function CSofwareDataSet() As DataSet
'open new connection to database
pCn = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=G:\CGI Project\CorrespondenceSoftware\Database1.accdb; Persist Security Info=False;")
Try
Call pCn.Open() 'opens the connection
Catch ex As Exception
MessageBox.Show("Could not open a database connection! 1")
MessageBox.Show(ex.ToString)
End Try
CSofwareDataSet = New DataSet
Dim daOPG As New OleDb.OleDbDataAdapter("SELECT * FROM Overpayment WHERE PayNumber='" & Main.tbPayNumber.Text & "' AND Gross=1", pCn) 'get all data from Overpayment Details table
Dim daOPN As New OleDb.OleDbDataAdapter("SELECT * FROM Overpayment WHERE PayNumber='" & Main.tbPayNumber.Text & "' AND Net=1", pCn) 'get all data from Overpayment Details table
Dim daOPR As New OleDb.OleDbDataAdapter("SELECT * FROM OvpReasons", pCn) 'get overpayment reasons
Dim daREC As New OleDb.OleDbDataAdapter("SELECT * FROM TaxYear", pCn) 'get recovery date options
Dim daEMP As New OleDb.OleDbDataAdapter("SELECT * FROM EmployeeDetails WHERE PayNumber='" & Main.tbPayNumber.Text & "' AND Active=1 ", pCn) 'get all data from Employee Details table
Dim daCON As New OleDb.OleDbDataAdapter("SELECT * FROM Consultant", pCn) 'get all data from Consultant Details table
Dim daSET As New OleDb.OleDbDataAdapter("SELECT * FROM Settings", pCn) 'get all data from Consultant Details table
'Find the primary key (if missing)
daOPG.MissingSchemaAction = MissingSchemaAction.AddWithKey
daOPN.MissingSchemaAction = MissingSchemaAction.AddWithKey
daOPR.MissingSchemaAction = MissingSchemaAction.AddWithKey
daREC.MissingSchemaAction = MissingSchemaAction.AddWithKey
daEMP.MissingSchemaAction = MissingSchemaAction.AddWithKey
daCON.MissingSchemaAction = MissingSchemaAction.AddWithKey
daSET.MissingSchemaAction = MissingSchemaAction.AddWithKey
'setup prefixes
Dim cbOPG As New OleDb.OleDbCommandBuilder(daOPG)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbOPN As New OleDb.OleDbCommandBuilder(daOPN)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbOPR As New OleDb.OleDbCommandBuilder(daOPR)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbREC As New OleDb.OleDbCommandBuilder(daREC)
cbOPG.QuotePrefix = "["
cbOPG.QuoteSuffix = "]"
Dim cbEMP As New OleDb.OleDbCommandBuilder(daEMP)
cbEMP.QuotePrefix = "["
cbEMP.QuoteSuffix = "]"
Dim cbCON As New OleDb.OleDbCommandBuilder(daCON)
cbEMP.QuotePrefix = "["
cbEMP.QuoteSuffix = "]"
Dim cbSET As New OleDb.OleDbCommandBuilder(daSET)
cbEMP.QuotePrefix = "["
cbEMP.QuoteSuffix = "]"
If CSofwareDataSet.HasChanges Then
Try
daEMP.Update(CSofwareDataSet, "EmployeeDetails")
daOPG.Update(CSofwareDataSet, "OverPaymentGross")
daOPN.Update(CSofwareDataSet, "OverPaymentNet")
daSET.Update(CSofwareDataSet, "Settings")
MessageBox.Show("Success! Records updated.")
update = "0"
Catch ex As Exception
MessageBox.Show("Oops - something went wrong and it didn't update")
update = "0"
End Try
ElseIf CSofwareDataSet.Tables.Count = 0 Then
daOPG.Fill(CSofwareDataSet, "OverPaymentGross")
daOPN.Fill(CSofwareDataSet, "OverPaymentNet")
daOPR.Fill(CSofwareDataSet, "OverPaymentReasons")
daREC.Fill(CSofwareDataSet, "RecoveryDates")
daEMP.Fill(CSofwareDataSet, "EmployeeDetails")
daCON.Fill(CSofwareDataSet, "ConsultantDetails")
daSET.Fill(CSofwareDataSet, "Settings")
End If
'If update = "1" Then
' Try
' daEMP.Update(CSofwareDataSet, "EmployeeDetails")
' daOPG.Update(CSofwareDataSet, "OverPaymentGross")
' daOPN.Update(CSofwareDataSet, "OverPaymentNet")
' daSET.Update(CSofwareDataSet, "Settings")
'
' MessageBox.Show("Success! Records updated.")
' update = "0"
' Catch ex As Exception
' MessageBox.Show("Oops - something went wrong and it didn't update")
' update = "0"
' End Try
' End If
pCn.Close()
End Function
End Module
On each form, it gets referenced like this (as an example):
Imports WeifenLuo.WinFormsUI.Docking
Imports Word = Microsoft.Office.Interop.Word
Imports CorrespondenceSoftware.Datasets
Public Class GrossInput
Dim loading = "1"
Dim NewEmployee = "0" 'sets the default new employee flag to 0
Private pCn As OleDb.OleDbConnection
Private Sub GrossInput_Load(ByVal Sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Try
Try
If CSofwareDataSet.Tables("EmployeeDetails").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("EmployeeDetails").Rows.Count - 1
cbTitle.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(2)
tbFName.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(3)
tbLName.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(4)
tbAddress1.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(5)
tbAddress2.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(6)
tbAddress3.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(7)
tbAddress4.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(8)
tbPostcode.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(9)
tbWorkLocation.Text = CSofwareDataSet.Tables("EmployeeDetails").Rows(i)(10)
tbWorkLocation.Enabled = False
tbPostcode.Enabled = False
tbAddress4.Enabled = False
tbAddress3.Enabled = False
tbAddress2.Enabled = False
tbAddress1.Enabled = False
tbLName.Enabled = False
tbFName.Enabled = False
cbTitle.Enabled = False
chkMSC.Enabled = False
chkOfficer.Enabled = False
chkStaff.Enabled = False
bnSaveEmp.Enabled = False
bnEditEmp.Enabled = True
Next
End If
If CSofwareDataSet.Tables("EmployeeDetails").Rows(0)(11) = "1" Then
chkOfficer.Checked = True
Else
chkOfficer.Checked = False
End If
If CSofwareDataSet.Tables("EmployeeDetails").Rows(0)(12) = "1" Then
chkStaff.Checked = True
Else
chkStaff.Checked = False
End If
If CSofwareDataSet.Tables("EmployeeDetails").Rows(0)(13) = "1" Then
chkMSC.Checked = True
Else
chkMSC.Checked = False
End If
Catch ex As Exception
MessageBox.Show(ex.ToString)
MessageBox.Show("Employee not found. Ensure pay number is correct and create a new record")
NewEmployee = "1" ' tells the program to create a new record if saved
cbReference.Enabled = False
cbReference.Text = ""
bnEditEmp.Enabled = False
End Try
'display the overpayment references to the user
If CSofwareDataSet.Tables("OverPaymentGross").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("OverPaymentGross").Rows.Count - 1
cbReference.Items.Add(CSofwareDataSet.Tables("OverPaymentGross").Rows(i)(2))
Next
End If
'display the available consultants to the user
If CSofwareDataSet.Tables("ConsultantDetails").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("ConsultantDetails").Rows.Count - 1
cbConsultant.Items.Add(CSofwareDataSet.Tables("ConsultantDetails").Rows(i)(1) & " " & CSofwareDataSet.Tables("ConsultantDetails").Rows(i)(2))
Next
End If
'display the available Overpayment reasons to the user
If CSofwareDataSet.Tables("OverPaymentReasons").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("OverPaymentReasons").Rows.Count - 1
cbReason.Items.Add(CSofwareDataSet.Tables("OverPaymentReasons").Rows(i)(1))
Next
End If
'Load other recovery date options
If CSofwareDataSet.Tables("RecoveryDates").Rows.Count > 0 Then
For i As Integer = 0 To CSofwareDataSet.Tables("RecoveryDates").Rows.Count - 1
cbStartRecovery.Items.Add(CSofwareDataSet.Tables("RecoveryDates").Rows(i)(1))
Next
End If
Catch ex As Exception
MessageBox.Show(ex.ToString) 'Show any errors to the user
End Try
loading = "0"
End Sub
Now! the problem that I'm having is that, this does work and run without any errors BUT every time the CSSoftwareDataSet function runs it populates the tables correctly and returns the expected results but it then deletes the datatable data so every time the function is referenced from a winform it needs to haul all the data from the access database from scratch, severely impacting on the performance of the program. The tables wont update properly because its not storing the datatable information and as soon as its inserted its forgotten but again, produces no errors. An example of my update script looks like this:
Else 'create a new record
'create a new reference
Dim REFRowCount = CSofwareDataSet.Tables("OverPaymentGross").Rows.Count + 1 'count the number of rows in table and add 1
Dim NewREF = "OVPG" & Main.tbPayNumber.Text & "-" & REFRowCount
'Find todays date and reply dates
Dim TodayDatedate = Format(Now.Date(), "dd/MM/yyyy")
Dim ReplyDatedate = Format(Now.Date.AddDays(21), "dd/MM/yyyy")
'Create a new row
Dim OPNew As DataRow = CSofwareDataSet.Tables("OverPaymentGross").NewRow() 'create a variable to contain the new row
OPNew.Item(1) = Main.tbPayNumber.Text
OPNew.Item(2) = NewREF
OPNew.Item(3) = tbOverpaymentAmount.Text.ToString
OPNew.Item(4) = tbMonRec.Text
OPNew.Item(5) = tbTaxP.Text
OPNew.Item(6) = TodayDatedate
OPNew.Item(7) = ReplyDatedate
OPNew.Item(8) = tbMoRep.Text
OPNew.Item(9) = cbStartRecovery.Text
OPNew.Item(10) = "1" 'Set as gross
OPNew.Item(11) = "0" 'do not set as net
OPNew.Item(12) = cbReason.Text
OPNew.Item(13) = tbAI.Text
OPNew.Item(14) = dtpStart.Value.Date
OPNew.Item(15) = dtpFinish.Value.Date
OPNew.Item(16) = cbConsultant.Text
OPNew.Item(17) = tbPosition.Text
Call CSofwareDataSet.Tables("OverPaymentGross").Rows.Add(OPNew) 'fill the new row and insert the data
There must be a solution to this. To create a dataset that holds its data in session while you open other winforms until it is reset. I'm out of ideas because i really don't want to go back to repeating all this code for practically every subroutine in my program.
I hope I've explained it OK .. Any help here will be greatly appreciated.
Many thanks,
Shane
You can declare the DataSet globally, populate it in a function (sub), which is called just at the start, and retrieve the information by accessing the variable rather than by calling the function over and over. Your code uses a somehow ambiguous approach (same name for function and for variable) which, together with the VB rules (functions might not include a Return statement but a variable with the function's name) does not play to your favor.
Sample code converting the DataSet into a public variable and renaming the function (and converting it into a sub: what is the point of a function now?):
Public CSofwareDataSet As DataSet
Public Sub populateDS()
'open new connection to database
pCn = New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=G:\CGI Project\CorrespondenceSoftware\Database1.accdb; Persist Security Info=False;")
Try
Call pCn.Open() 'opens the connection
Catch ex As Exception
MessageBox.Show("Could not open a database connection! 1")
MessageBox.Show(ex.ToString)
End Try
CSofwareDataSet = New DataSet
'Remaining code
End Sub
Call this sub just once (right at the start of your application; or every time new data has to be retrieved from the DB) and continue using CSofwareDataSet as so far (although as a variable, by removing the Call bits; which, on the other hand, are not required in VB.NET at all).