简体   繁体   中英

OleDbDataAdapter Fill and OleDbDataReader takes 3-5 minutes to fill

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

使用 OleDbDataAdapter 填充数据表的日志文件

使用 OleDbDataReader 的日志文件

   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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM