OleDbDataAdapter Fill 和 OleDbDataReader 需要 3-5 分钟才能填充

Question

这是一个非常奇怪的问题，因为它只发生在随机的全新 Windows 10 电脑上。填充数据适配器或数据读取器需要 1-5 分钟。这是从 Windows 7 旧电脑升级到全新的 Windows 10 电脑时遇到的第三台电脑。一年前第一次出现，问题只出现了1天。第二次我们无法修复它，只是将它们放回旧的 Windows 7 电脑上。现在它又发生了。我们已经用相同型号的 Nuc 10i7 计算机替换了另外 4 台运行此程序的计算机，它们运行良好，只需 1-5 秒即可完成所有例程。

我不认为它是连接字符串或 SQL 语句，因为它在其他电脑上工作正常。

我将延迟隔离到 OleDbDataAdapter 或 OleDbDataReader 被填充的时间，这在下面的屏幕截图中很明显，在填充前后使用了日志记录功能。

这是在 Nuc10i7 pc 上，VB.Net 程序从 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()

请注意 ****** 此代码在某些 PC 上运行良好，这就是我最初没有提供代码的原因。我现在在联想 thinkpad 上，代码使用数据读取器或适配器方法运行良好。它有时会在 intel 的 Nuc 10 i7 上运行良好，但有时却不像我上面描述的那样运行。*********

下面是使用dataAdapter和datatable方法的代码：

 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

您的 Access 数据库可能已损坏。下面的代码包含多种可能有用的方法，包括CompactAccessDatabase 和CompactAccessDatabaseMDBOnly - 如果需要，压缩还会修复数据库。由于 OP 中提到的表没有提供数据类型，“CreateTblSwatLog”和“CreateTblTempCert”中的数据类型可能需要更新。

添加对您项目的引用：

VS 2019：

• 点击项目
• 选择添加参考
• 点击COM
• 检查 Microsoft Jet 和复制对象 2.6 库
• 检查 Microsoft ADO 分机。 6.0 用于 DDL 和安全性
• 检查 Microsoft DAO 3.6 对象库
• 检查 Microsoft Access xx.x 对象库
• 点击程序集
• 检查 System.Data（如果尚未检查）

创建模块（名称：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

资源

• 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