OleDbDataAdapter Fill and OleDbDataReader takes 3-5 minutes to fill - vb.net

Question

This is a really strange problem as it only happens on random brand new Windows 10 pc's. It will take anywhere from 1-5 minutes to fill the data adapter or data reader. This is the 3rd pc it has happened to when upgrading from a Windows 7 old pc to a brand new windows 10 pc. The first time it happened a year ago, the problem only occurred for 1 day. The second time we could not fix it and just put them back on their old Windows 7 pc. And now it is happening again. We have replaced 4 other pc's that run this program with the same model Nuc 10i7 computer and they work just fine only taking 1-5 seconds to get through all the routines.
I don't think it is the connection string or the SQL statement since it works fine on other pc's.
I isolated the delay to when the OleDbDataAdapter or the OleDbDataReader are being filled which is evident in the screenshots below using a logging function before and after the fill.
This is on Nuc10i7 pc, VB.Net program calling one row of data from an Access db.
Public Sub PrintSwatLoad(SwatKey As String)
didPrint = True
Try
Dim sBarcode As String = ""
Dim cn As New OleDbConnection(MDBConnect)
Dim sSql As String = "" &
"SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
"Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
"TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
"ScaleLoad, LoadNo, Logger, LogMethod, Block, Val(Gross) as GrossWt, " &
"Val(Tare) as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
"Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
"Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
"Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
"ManualWeight, DeputyName, CertStatus, ReplacedCert " &
"FROM Swatlog INNER JOIN tblTempCert " &
"ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
"WHERE [tblTempCert].[SwatDate] = #" & SwatKey & "#"
cn.Open()
Dim cmd As New OleDbCommand(sSql, cn)
'Dim da As New OleDbDataAdapter(cmd)
'Dim ds As New DataSet
Dim dt As New DataTable
''''''''right here is where it hangs'''''''''''''''''''
Dim myreader As OleDbDataReader = cmd.ExecuteReader()
''''''''above this is where it hangs. deleted all my logging methods for clarity''''''''''
'''
While myreader.Read()
If myreader.HasRows = True Then 'ds.Tables(0).Rows.Count
'Dim WrkRow As DataRow = dt.Rows(0) 'ds.Tables(0).Rows(0)
If IsTareout = True Then
sBarcode = Trim(myreader("Trucker")) & myreader("TruckNo")
End If
Dim rSwatLaserCert As New XRSwatLaserCert
rSwatLaserCert.DataSource = dt
Dim rpt As New DevExpress.XtraReports.UI.ReportPrintTool(rSwatLaserCert)
With rSwatLaserCert
.XrBCTareOut.Text = sBarcode
If Not (myreader("ManualWeight") = 1 Or myreader("ManualWeight") = 3) Then
.XrLabelManualGross1.Visible = False
.XrLabelManualGross2.Visible = False
.XrLabelManualGross3.Visible = False
End If
If Not (myreader("ManualWeight") = 2 Or myreader("ManualWeight") = 3) Then
.XrLabelManualTare1.Visible = False
.XrLabelManualTare2.Visible = False
.XrLabelManualTare3.Visible = False
End If
If myreader("CertStatus") = 1 Then
ElseIf myreader("CertStatus") = 2 Then
.XrLabelCertStatus1.Text = "VOID"
.XrLabelCertStatus2.Text = "VOID"
.XrLabelCertStatus3.Text = "VOID"
Else
.XrLabelCertStatus1.Visible = False
.XrLabelCertStatus2.Visible = False
.XrLabelCertStatus3.Visible = False
End If
If IsDBNull(myreader("DeputyName")) = True Then
.XrLabelDeputy1.Text = myreader("Weighmaster")
.XrLabelDeputy2.Text = myreader("Weighmaster")
.XrLabelDeputy3.Text = myreader("Weighmaster")
Else
.XrLabelDeputy1.Text = myreader("DeputyName")
.XrLabelDeputy2.Text = myreader("DeputyName")
.XrLabelDeputy3.Text = myreader("DeputyName")
End If
If NoNull(myreader("ReplacedCert")) = "" Then 'Replaced this line: If IsDBNull(myreader("ReplacedCert")) = True Then
.XrLabelReplacesLabel1.Visible = False
.XrLabelReplacesLabel2.Visible = False
.XrLabelReplacesLabel3.Visible = False
.XrLabel174.Visible = False ' Replaces cert 1
.XrLabel113.Visible = False ' Replaces cert 2
.XrLabel178.Visible = False ' Replaces cert 3
.XrLabel174.BorderWidth = 0 ' Replaces cert 1
.XrLabel113.BorderWidth = 0 ' Replaces cert 2
.XrLabel178.BorderWidth = 0 ' Replaces cert 3
Else
.XrLabel174.Text = myreader("ReplacedCert") ' Replaces cert 1
.XrLabel113.Text = myreader("ReplacedCert") ' Replaces cert 2
.XrLabel178.Text = myreader("ReplacedCert") ' Replaces cert 3
End If
End With
rpt.Print()
End If
End While
cn.Close()
Please note ****** this code works perfectly fine on certain PC's which is why I didn't provide the code originally. I am on a Lenovo thinkpad right now and the code runs fine with either the datareader or adapter methods. It will run fine on intel's Nuc 10 i7 sometimes and then sometimes it doesn't as I described above.*********
Here is the code using the dataAdapter and datatable method:
Public Sub PrintSwatLoad(SwatKey As String)
didPrint = True
Try
Dim sBarcode As String = ""
Dim cn As New OleDbConnection(MDBConnect)
Dim sSql As String = "" &
"SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
"Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
"TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
"ScaleLoad, LoadNo, Logger, LogMethod, Block, Val(Gross) as GrossWt, " &
"Val(Tare) as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
"Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
"Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
"Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
"ManualWeight, DeputyName, CertStatus, ReplacedCert " &
"FROM Swatlog INNER JOIN tblTempCert " &
"ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
"WHERE [tblTempCert].[SwatDate] = #" & SwatKey & "#"
Dim cmd As New OleDbCommand(sSql, cn)
Dim da As New OleDbDataAdapter(cmd)
Dim ds As New DataSet
Dim dt As New DataTable
cn.Open()
''''''''''This is where it hangs using the dataAdapter fill'''''''''''
da.Fill(dt)
''''''''''Above is where it hangs''''''''''''''''''''''''''''
ds.Tables.Add(dt) ' added this to dataset
dt.TableName = "dataset"
cn.Close()
If dt.Rows.Count > 0 Then 'ds.Tables(0).Rows.Count
Dim WrkRow As DataRow = dt.Rows(0) 'ds.Tables(0).Rows(0)
If IsTareout = True Then
sBarcode = Trim(WrkRow("Trucker")) & WrkRow("TruckNo")
End If
Dim rSwatLaserCert As New XRSwatLaserCert
rSwatLaserCert.DataSource = dt
Dim rpt As New DevExpress.XtraReports.UI.ReportPrintTool(rSwatLaserCert)
With rSwatLaserCert
.XrBCTareOut.Text = sBarcode
If Not (WrkRow("ManualWeight") = 1 Or WrkRow("ManualWeight") = 3) Then
.XrLabelManualGross1.Visible = False
.XrLabelManualGross2.Visible = False
.XrLabelManualGross3.Visible = False
End If
If Not (WrkRow("ManualWeight") = 2 Or WrkRow("ManualWeight") = 3) Then
.XrLabelManualTare1.Visible = False
.XrLabelManualTare2.Visible = False
.XrLabelManualTare3.Visible = False
End If
If WrkRow("CertStatus") = 1 Then
ElseIf WrkRow("CertStatus") = 2 Then
.XrLabelCertStatus1.Text = "VOID"
.XrLabelCertStatus2.Text = "VOID"
.XrLabelCertStatus3.Text = "VOID"
Else
.XrLabelCertStatus1.Visible = False
.XrLabelCertStatus2.Visible = False
.XrLabelCertStatus3.Visible = False
End If
If IsDBNull(WrkRow("DeputyName")) = True Then
.XrLabelDeputy1.Text = WrkRow("Weighmaster")
.XrLabelDeputy2.Text = WrkRow("Weighmaster")
.XrLabelDeputy3.Text = WrkRow("Weighmaster")
Else
.XrLabelDeputy1.Text = WrkRow("DeputyName")
.XrLabelDeputy2.Text = WrkRow("DeputyName")
.XrLabelDeputy3.Text = WrkRow("DeputyName")
End If
If NoNull(WrkRow("ReplacedCert")) = "" Then 'Replaced this line: If IsDBNull(WrkRow("ReplacedCert")) = True Then
.XrLabelReplacesLabel1.Visible = False
.XrLabelReplacesLabel2.Visible = False
.XrLabelReplacesLabel3.Visible = False
.XrLabel174.Visible = False ' Replaces cert 1
.XrLabel113.Visible = False ' Replaces cert 2
.XrLabel178.Visible = False ' Replaces cert 3
.XrLabel174.BorderWidth = 0 ' Replaces cert 1
.XrLabel113.BorderWidth = 0 ' Replaces cert 2
.XrLabel178.BorderWidth = 0 ' Replaces cert 3
Else
.XrLabel174.Text = WrkRow("ReplacedCert") ' Replaces cert 1
.XrLabel113.Text = WrkRow("ReplacedCert") ' Replaces cert 2
.XrLabel178.Text = WrkRow("ReplacedCert") ' Replaces cert 3
End If
End With
rpt.Print()
End If
ds.Tables.Remove("dataset")
da.Dispose()
Catch ex As Exception
RecordEvent("Cert error: " & SwatKey & " - " & Reason & " (" & ex.Message & ")", True)
End Try
didPrint = False
End Sub
Public Sub GetKeyAndReason(ByRef sKey As String, ByRef sReason As String)
Dim sSql As String = "SELECT SwatDate, Reason FROM tblTempCert"
Dim cn As New OleDbConnection(MDBConnect)
Dim da As New OleDbDataAdapter(sSql, cn)
Dim ds As New DataSet
Dim dt As New DataTable
da.Fill(dt)
If dt.Rows.Count > 0 Then
Dim WorkRow1 As DataRow = dt.Rows(0)
sKey = WorkRow1("SwatDate").ToString
sReason = WorkRow1("Reason").ToString
End If
dt.Dispose()
da.Dispose()
cn.Dispose()
End Sub

Answer 1

It's possible that your Access database is corrupt. The code below contains a variety of methods that may be useful, including CompactAccessDatabase and CompactAccessDatabaseMDBOnly - compacting also repairs the database, if needed. Since the data types weren't provided for the tables mentioned in the OP, the data types in "CreateTblSwatLog" and "CreateTblTempCert" may need to be updated.
Add references to your project:
VS 2019:
Click Project
Select Add Reference
Click COM
Check Microsoft Jet and Replication Objects 2.6 Library
Check Microsoft ADO Ext. 6.0 for DDL and Security
Check Microsoft DAO 3.6 Object Library
Check Microsoft Access xx.x Object Library
Click Assemblies
Check System.Data (if not already checked)
Create a module (name: Helper)
Imports System.IO
Imports System.Data.OleDb
Module HelperAccess
Private didPrint As Boolean = False
'Private MDBConnect As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\SWAT\Pclogs.mdb;User Id=admin;Password=;"
Private MDBConnect As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\SWAT\Pclogs.mdb;Mode=Share Exclusive;User Id=admin;Password=;"
'Private MDBConnect As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\SWAT\Pclogs.mdb;Persist Security Info=False;"
Public Property IsTareOut As Boolean = True
Public Sub CompactAccessDatabase(filename As String)
'Add reference
'Project => Add Reference => COM => Microsoft Access xx.x Object Library
'compacts Access database by copying the database to a new file and replacing the original file
'Note: this method works with both .mdb and .accdb files
Try
If String.IsNullOrEmpty(filename) OrElse Not System.IO.File.Exists(filename) Then
Throw New Exception("Error: Access database '" & filename & "' doesn't exist.")
End If
Dim fileExt As String = Path.GetExtension(filename).ToLower()
Dim tempFilename As String = Path.Combine(Path.GetDirectoryName(filename), Path.GetFileNameWithoutExtension(filename) & "_temp" & Path.GetExtension(filename))
Debug.WriteLine("Info: Compacting '" & filename & "'...")
Dim dbe As New Microsoft.Office.Interop.Access.Dao.DBEngine
'invoke CompactDatabase - compacts database to temp file
dbe.CompactDatabase(filename, tempFilename)
'delete original database file
System.IO.File.Delete(filename)
System.IO.File.Move(tempFilename, filename)
'release COM object
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(dbe)
Debug.WriteLine("Info: Database compacted: '" & filename & "'")
Catch ex As Exception
Throw ex
End Try
End Sub
Public Sub CompactAccessDatabaseMDBOnly(filename As String)
'Add reference
'Project => Add Reference => COM => Microsoft DAO 3.6 Object Library
'compacts Access database by copying the database to a new file and replacing the original file
'Note: this method works with only .mdb files
Try
If String.IsNullOrEmpty(filename) OrElse Not System.IO.File.Exists(filename) Then
Throw New Exception("Error: Access database '" & filename & "' doesn't exist.")
End If
Dim fileExt As String = Path.GetExtension(filename).ToLower()
Dim tempFilename As String = Path.Combine(Path.GetDirectoryName(filename), Path.GetFileNameWithoutExtension(filename) & "_temp" & Path.GetExtension(filename))
Debug.WriteLine("Info: Compacting '" & filename & "'...")
Dim dbe As New DAO.DBEngine
'invoke CompactDatabase - compacts database to temp file
dbe.CompactDatabase(filename, tempFilename)
'delete original database file
System.IO.File.Delete(filename)
System.IO.File.Move(tempFilename, filename)
'release COM object
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(dbe)
Debug.WriteLine("Info: Database compacted: '" & filename & "'")
Catch ex As Exception
Throw ex
End Try
End Sub
Public Sub CompactAccessDatabaseMDBOnly2(filename As String)
'Add reference
'Project => Add Reference => COM => Microsoft Jet and Replication Objects 2.6 Library
'compacts Access database by copying the database to a new file and replacing the original file
'Note: this method is only for .mdb files
Try
If String.IsNullOrEmpty(filename) OrElse Not System.IO.File.Exists(filename) Then
Throw New Exception("Error: Access database '" & filename & "' doesn't exist.")
End If
Dim fileExt As String = Path.GetExtension(filename).ToLower()
'must be .mdb to compact
If fileExt <> ".mdb" Then
Throw New Exception("Error: Compacting database with '" & fileExt & "' isn't supported.")
End If
Dim connectionString As String = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Mode=Share Exclusive;User Id=admin;Password=;", filename)
Dim tempFilename As String = Path.Combine(Path.GetDirectoryName(filename), Path.GetFileNameWithoutExtension(filename) & "_temp" & Path.GetExtension(filename))
'Dim connectionStringTemp As String = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};", tempFilename)
Dim connectionStringTemp As String = String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Jet OLEDB:Engine Type=5", tempFilename)
'Debug.WriteLine("connectionString: " & connectionString)
'Debug.WriteLine("tempFilename: " & tempFilename)
'Debug.WriteLine("connectionStringTemp: " & connectionStringTemp)
'create instance of Jet Replication Object
Dim objJRO = Activator.CreateInstance(Type.GetTypeFromProgID("JRO.JetEngine"))
'Engine Type:
'1: JET10
'2: JET11
'3: JET2x
'4: JET3x
'5: JET4x
'Dim oParams = {connectionString, String.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0};Jet OLEDB:Engine Type=5", tempFilename)}
Dim oParams = {connectionString, connectionStringTemp}
Debug.WriteLine("Info: Compacting '" & filename & "'...")
'invoke CompactDatabase - compacts database to temp file
objJRO.GetType().InvokeMember("CompactDatabase", System.Reflection.BindingFlags.InvokeMethod, Nothing, objJRO, oParams)
'delete original database file
System.IO.File.Delete(filename)
System.IO.File.Move(tempFilename, filename)
'release COM object
'System.Runtime.InteropServices.Marshal.ReleaseComObject(objJRO)
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(objJRO)
Debug.WriteLine("Info: Database compacted: '" & filename & "'")
Catch ex As Exception
Throw ex
End Try
End Sub
Public Function CreateDatabase() As String
'Add reference
'Project => Add Reference => COM => Microsoft ADO Ext. 6.0 for DDL and Security
Dim result As String = String.Empty
Dim cat As ADOX.Catalog = Nothing
Try
'create New instance
cat = New ADOX.Catalog()
'create Access database
cat.Create(MDBConnect)
'set value
result = String.Format("Status: Database created.")
Return result
Catch ex As Exception
'set value
result = String.Format("Error (CreateDatabase): {0}(Connection String: {1})", ex.Message, MDBConnect)
Return result
Finally
If cat IsNot Nothing Then
'close connection
cat.ActiveConnection.Close()
'release COM object
System.Runtime.InteropServices.Marshal.ReleaseComObject(cat)
cat = Nothing
End If
End Try
End Function
Public Function CreateTblSwatLog() As String
Dim result As String = String.Empty
Dim tableName As String = "SwatLog"
Dim sqlText = String.Empty
sqlText = "CREATE TABLE SwatLog "
sqlText += "(ID AUTOINCREMENT not null primary key,"
sqlText += " [WeightCert] varchar(50),"
sqlText += " [SwatDate] DateTime,"
sqlText += " [TareDate] DateTime,"
sqlText += " [SaleCode] varchar(50),"
sqlText += " [Species] varchar(50),"
sqlText += " [Qual] varchar(50),"
sqlText += " [SaleDesc] varchar(50),"
sqlText += " [Trucker] varchar(50),"
sqlText += " [TruckNo] varchar(50),"
sqlText += " [TruckState] varchar(50),"
sqlText += " [TruckLic] varchar(50),"
sqlText += " [TrlState] varchar(50),"
sqlText += " [TrlLic] varchar(50),"
sqlText += " [TruckType] varchar(50),"
sqlText += " [Comments] varchar(150),"
sqlText += " [TareLoad] varchar(50),"
sqlText += " [ScaleLoad] varchar(50),"
sqlText += " [LoadNo] integer,"
sqlText += " [Logger] varchar(50),"
sqlText += " [LogMethod] varchar(50),"
sqlText += " [Block] varchar(50),"
sqlText += " [Gross] varchar(25),"
sqlText += " [Tare] varchar(25),"
sqlText += " [Weight] numeric(18,2),"
sqlText += " [PrintAvg] numeric(18,2),"
sqlText += " [Brand] varchar(50),"
sqlText += " [Commodity] varchar(50),"
sqlText += " [SortCode] varchar(50),"
sqlText += " [Deck] varchar(50),"
sqlText += " [UserInfo1] varchar(50),"
sqlText += " [UserInfo2] varchar(50),"
sqlText += " [EmergencyLevel] integer,"
sqlText += " [ReprintCount] integer,"
sqlText += " [Reason] varchar(75),"
sqlText += " [LocationName] varchar(50),"
sqlText += " [Addr1] varchar(50),"
sqlText += " [Addr2] varchar(50),"
sqlText += " [OwnerName] varchar(50),"
sqlText += " [LoggerName] varchar(75),"
sqlText += " [Contract] varchar(50),"
sqlText += " [Weighmaster] varchar(50),"
sqlText += " [TT] varchar(50),"
sqlText += " [Reprint] bit,"
sqlText += " [TareoutBarcode] Longbinary,"
sqlText += " [PrintTare] bit,"
sqlText += " [TruckName] varchar(50),"
sqlText += " [ManualWeight] varchar(50),"
sqlText += " [DeputyName] varchar(50),"
sqlText += " [CertStatus] varchar(50),"
sqlText += " [ReplacedCert] varchar(50));"
Try
Debug.WriteLine(sqlText)
'create database table
ExecuteNonQuery(sqlText)
result = String.Format("Table created: '{0}'", tableName)
Catch ex As OleDbException
'result = String.Format("Error (CreateTblSwatLog - OleDbException): Table creation failed: '{0}'; {1}", tableName, ex.Message)
Throw ex
Catch ex As Exception
'result = String.Format("Error (CreateTblSwatLog): Table creation failed: '{0}'; {1}", tableName, ex.Message)
Throw ex
End Try
Return result
End Function
Public Function CreateTblSwatLog2() As String
Dim result As String = String.Empty
Dim tableName As String = "SwatLog"
Dim sqlText = String.Empty
sqlText = "CREATE TABLE SwatLog "
sqlText += "(ID AUTOINCREMENT not null primary key,"
sqlText += " [WeightCert] varchar(50),"
sqlText += " [SwatDate] DateTime,"
sqlText += " [TareDate] DateTime,"
sqlText += " [SaleCode] varchar(50),"
sqlText += " [Species] varchar(50),"
sqlText += " [Qual] varchar(50),"
sqlText += " [SaleDesc] varchar(50),"
sqlText += " [Trucker] varchar(50),"
sqlText += " [TruckNo] varchar(50),"
sqlText += " [TruckState] varchar(50),"
sqlText += " [TruckLic] varchar(50),"
sqlText += " [TrlState] varchar(50),"
sqlText += " [TrlLic] varchar(50),"
sqlText += " [TruckType] varchar(50),"
sqlText += " [Comments] varchar(150),"
sqlText += " [TareLoad] varchar(50),"
sqlText += " [ScaleLoad] varchar(50),"
sqlText += " [LoadNo] integer,"
sqlText += " [Logger] varchar(50),"
sqlText += " [LogMethod] varchar(50),"
sqlText += " [Block] varchar(50),"
sqlText += " [Gross] numeric(18,2),"
sqlText += " [Tare] numeric(18,2),"
sqlText += " [Weight] numeric(18,2),"
sqlText += " [PrintAvg] numeric(18,2),"
sqlText += " [Brand] varchar(50),"
sqlText += " [Commodity] varchar(50),"
sqlText += " [SortCode] varchar(50),"
sqlText += " [Deck] varchar(50),"
sqlText += " [UserInfo1] varchar(50),"
sqlText += " [UserInfo2] varchar(50),"
sqlText += " [EmergencyLevel] integer,"
sqlText += " [ReprintCount] integer,"
sqlText += " [Reason] varchar(75),"
sqlText += " [LocationName] varchar(50),"
sqlText += " [Addr1] varchar(50),"
sqlText += " [Addr2] varchar(50),"
sqlText += " [OwnerName] varchar(50),"
sqlText += " [LoggerName] varchar(75),"
sqlText += " [Contract] varchar(50),"
sqlText += " [Weighmaster] varchar(50),"
sqlText += " [TT] varchar(50),"
sqlText += " [Reprint] bit,"
sqlText += " [TareoutBarcode] Longbinary,"
sqlText += " [PrintTare] bit,"
sqlText += " [TruckName] varchar(50),"
sqlText += " [ManualWeight] varchar(50),"
sqlText += " [DeputyName] varchar(50),"
sqlText += " [CertStatus] varchar(50),"
sqlText += " [ReplacedCert] varchar(50));"
Try
Debug.WriteLine(sqlText)
'create database table
ExecuteNonQuery(sqlText)
result = String.Format("Table created: '{0}'", tableName)
Catch ex As OleDbException
'result = String.Format("Error (CreateTblSwatLog - OleDbException): Table creation failed: '{0}'; {1}", tableName, ex.Message)
Throw ex
Catch ex As Exception
'result = String.Format("Error (CreateTblSwatLog): Table creation failed: '{0}'; {1}", tableName, ex.Message)
Throw ex
End Try
Return result
End Function
Public Function CreateTblTempCert() As String
Dim result As String = String.Empty
Dim tableName As String = "tblTempCert"
Dim sqlText = String.Empty
sqlText = "CREATE TABLE tblTempCert "
sqlText += "(ID AUTOINCREMENT not null primary key,"
sqlText += " [SwatDate] DateTime);"
Try
'create database table
ExecuteNonQuery(sqlText)
result = String.Format("Table created: '{0}'", tableName)
Catch ex As OleDbException
'result = String.Format("Error (CreateTblSwatLog - OleDbException): Table creation failed: '{0}'; {1}", tableName, ex.Message)
Throw ex
Catch ex As Exception
'result = String.Format("Error (CreateTblSwatLog): Table creation failed: '{0}'; {1}", tableName, ex.Message)
Throw ex
End Try
Return result
End Function
Private Function ExecuteNonQuery(sqlText As String) As Integer
Dim rowsAffected As Integer = 0
'used for insert/update
'create new connection
Using cn As OleDbConnection = New OleDbConnection(MDBConnect)
'open
cn.Open()
'create new instance
Using cmd As OleDbCommand = New OleDbCommand(sqlText, cn)
'execute
rowsAffected = cmd.ExecuteNonQuery()
End Using
End Using
Return rowsAffected
End Function
Public Sub PrintSwatLoad(SwatKey As String)
'set value
didPrint = True
'create new instance
Dim dt As New DataTable
'create new instance
Dim ds As New DataSet
Try
Dim sBarcode As String = ""
Dim sSql As String = String.Empty
'sSql = "SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
' "Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
' "TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
' "ScaleLoad, LoadNo, Logger, LogMethod, Block, Val(Gross) as GrossWt, " &
' "Val(Tare) as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
' "Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
' "Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
' "Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
' "ManualWeight, DeputyName, CertStatus, ReplacedCert " &
' "FROM Swatlog INNER JOIN tblTempCert " &
' "ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
' "WHERE [tblTempCert].[SwatDate] = ?;"
sSql = "SELECT WeightCert, [SwatLog].[SwatDate], TareDate, SaleCode, " &
"Species, Qual, SaleDesc, Trucker, TruckNo, TruckState, " &
"TruckLic, TrlState, TrlLic, TruckType, Comments, TareLoad, " &
"ScaleLoad, LoadNo, Logger, LogMethod, Block, Gross as GrossWt, " &
"Tare as TareWt, Weight, PrintAvg, Brand, Commodity, SortCode, " &
"Deck, UserInfo1, UserInfo2, EmergencyLevel, ReprintCount, " &
"Reason, LocationName, Addr1, Addr2, OwnerName, LoggerName," &
"Contract, Weighmaster, TT, Reprint, TareoutBarcode, PrintTare, TruckName, " &
"ManualWeight, DeputyName, CertStatus, ReplacedCert " &
"FROM Swatlog INNER JOIN tblTempCert " &
"ON [SwatLog].[SwatDate] = [tblTempCert].[SwatDate] " &
"WHERE [tblTempCert].[SwatDate] = ?;"
Using cn As New OleDbConnection(MDBConnect)
'open
cn.Open()
Dim swatDate As DateTime = DateTime.MaxValue
'try to convert to DateTime
DateTime.TryParse(SwatKey, swatDate)
Using cmd As New OleDbCommand(sSql, cn)
'add parameters
cmd.Parameters.Add("!swatDate", OleDbType.DBDate).Value = swatDate
'ToDo: remove the following code that is for debugging
For Each p As OleDbParameter In cmd.Parameters
Debug.WriteLine(p.ParameterName & ": " & p.Value.ToString())
Next
Debug.WriteLine(cmd.CommandText)
Using da As New OleDbDataAdapter(cmd)
'fill DataTable
da.Fill(dt)
'add to DataSet
ds.Tables.Add(dt) ' added this to dataset
dt.TableName = "dataset"
'Debug.WriteLine("table count: " & ds.Tables.Count)
'For i As Integer = 0 To ds.Tables.Count - 1 Step 1
'Debug.WriteLine("table: " & ds.Tables(i).TableName)
'Next
End Using
End Using
End Using
If dt.Rows.Count > 0 Then 'ds.Tables(0).Rows.Count
Dim WrkRow As DataRow = dt.Rows(0) 'ds.Tables(0).Rows(0)
If IsTareOut = True Then
'sBarcode = Trim(WrkRow("Trucker")) & WrkRow("TruckNo")
sBarcode = Trim(WrkRow("Trucker")) & " - " & WrkRow("TruckNo")
Debug.WriteLine("sBarcode: " & sBarcode)
End If
'ToDo: add desired code
End If
Catch ex As OleDbException
'ToDo: add desired code
'RecordEvent("Cert error: " & SwatKey & " - " & Reason & " (" & ex.Message & ")", True)
Throw ex
Catch ex As Exception
'ToDo: add desired code
'RecordEvent("Cert error: " & SwatKey & " - " & Reason & " (" & ex.Message & ")", True)
Throw ex
End Try
'set value
didPrint = False
End Sub
Public Function TblSwatLogInsert(swatDate As DateTime, trucker As String, truckNo As String, weight As String, tare As String, comments As String) As Integer
Dim rowsAffected As Integer = 0
Dim sqlText As String = String.Empty
sqlText = "INSERT INTO SwatLog ([SwatDate], [Trucker], [TruckNo], [Weight], [Tare], [Comments]) VALUES (?, ?, ?, ?, ?, ?);"
Try
'insert data to database
'create new connection
Using cn As OleDbConnection = New OleDbConnection(MDBConnect)
'open
cn.Open()
'create new instance
Using cmd As OleDbCommand = New OleDbCommand(sqlText, cn)
'OLEDB doesn't use named parameters in SQL. Any names specified will be discarded and replaced with '?'
'However, specifying names in the parameter 'Add' statement can be useful for debugging
'Since OLEDB uses anonymous names, the order which the parameters are added is important
'if a column is referenced more than once in the SQL, then it must be added as a parameter more than once
'parameters must be added in the order that they are specified in the SQL
'if a value is null, the value must be assigned as: DBNull.Value
'add parameters
With cmd.Parameters
.Add("!swatDate", OleDbType.DBDate).Value = swatDate
.Add("!trucker", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(trucker), DBNull.Value, trucker)
.Add("!truckNo", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(truckNo), DBNull.Value, truckNo)
.Add("!weight", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(weight), 0, weight)
.Add("!tare", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(tare), 0, tare)
.Add("!comments", OleDbType.VarChar).Value = If(String.IsNullOrEmpty(comments), DBNull.Value, comments)
End With
'ToDo: remove the following code that is for debugging
'For Each p As OleDbParameter In cmd.Parameters
'Debug.WriteLine(p.ParameterName & ": " & p.Value.ToString())
'Next
'execute
rowsAffected = cmd.ExecuteNonQuery()
End Using
End Using
Catch ex As OleDbException
Debug.WriteLine("Error (TblSwatLogInsert - OleDbException) - " & ex.Message & "(" & sqlText & ")")
Throw ex
Catch ex As Exception
Debug.WriteLine("Error (TblSwatLogInsert) - " & ex.Message & "(" & sqlText & ")")
Throw ex
End Try
Return rowsAffected
End Function
Public Function TblTempCertInsert(swatDate As DateTime) As Integer
Dim rowsAffected As Integer = 0
Dim sqlText As String = String.Empty
sqlText = "INSERT INTO tblTempCert ([SwatDate]) VALUES (?);"
Try
'insert data to database
'create new connection
Using cn As OleDbConnection = New OleDbConnection(MDBConnect)
'open
cn.Open()
'create new instance
Using cmd As OleDbCommand = New OleDbCommand(sqlText, cn)
'OLEDB doesn't use named parameters in SQL. Any names specified will be discarded and replaced with '?'
'However, specifying names in the parameter 'Add' statement can be useful for debugging
'Since OLEDB uses anonymous names, the order which the parameters are added is important
'if a column is referenced more than once in the SQL, then it must be added as a parameter more than once
'parameters must be added in the order that they are specified in the SQL
'if a value is null, the value must be assigned as: DBNull.Value
'add parameters
With cmd.Parameters
.Add("!swatDate", OleDbType.DBDate).Value = swatDate
End With
'ToDo: remove the following code that is for debugging
'For Each p As OleDbParameter In cmd.Parameters
'Debug.WriteLine(p.ParameterName & ": " & p.Value.ToString())
'Next
'execute
rowsAffected = cmd.ExecuteNonQuery()
End Using
End Using
Catch ex As OleDbException
Debug.WriteLine("Error (TblTempCertInsert - OleDbException) - " & ex.Message & "(" & sqlText & ")")
Throw ex
Catch ex As Exception
Debug.WriteLine("Error (TblTempCertInsert) - " & ex.Message & "(" & sqlText & ")")
Throw ex
End Try
Return rowsAffected
End Function
End Module
Resources
Converting Access OLE object image to show in Datagridview vb.net
Compact and Repair Access Database using C# ?
How do I compact and repair an ACCESS 2007 database by .NET code?
jro.jetengine not being recognised..
Compact and Repair Access Database using C# and Late Binding