access.bas

VB开发的数据库操作通用模块,可读写数据库等

Attribute VB_Name = "Module1"
Option Explicit
Public sqlStr As String
Dim DataSource, ConnectionString As String
Public datainfo(15) As String, ColumnNames() As String
Public ColCount As Integer, RowCount As Integer
Public 时间 As String
Public ColumnList(16) As String
Public ColumnValue(16) As String




Public Sub Setdata(DataIn() As String)
'ReDim DataIn(16) As String

On Error GoTo errHandle
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Set cn = New ADODB.Connection
    cn.ConnectionString = DefaultConnString
    
    Set rs = New ADODB.Recordset
    sqlStr = "select * from BarCodeData"
    
    cn.Open
    rs.Open sqlStr, cn, adOpenKeyset, adLockOptimistic

    '添加记录到数据库
    rs.AddNew
    rs.Fields("LINE") = DataIn(0)
    rs.Fields("机种型号") = DataIn(1)
    rs.Fields("机器型号") = DataIn(2)
    rs.Fields("工单号") = DataIn(3)
    rs.Fields("工单数量") = Val(DataIn(4))
    rs.Fields("操作员") = DataIn(5)
    rs.Fields("生产日期") = DataIn(6)
    rs.Fields("时间") = DataIn(7)
    rs.Fields("HYT物料编码") = DataIn(8)
    rs.Fields("物料描述") = DataIn(9)
    rs.Fields("物料LOT_No") = DataIn(10)
    rs.Fields("XFT_IQC质检号") = DataIn(11)
    rs.Fields("位置") = DataIn(12)
    rs.Fields("数量") = Val(DataIn(13))
    rs.Fields("换料人") = DataIn(14)
    rs.Fields("备注") = DataIn(15)
    rs.Update
   ' MsgBox "数据保存成功！", vbOKOnly + vbDefaultButton1 + vbInformation, "提示"
    rs.Close
    cn.Close
    
    Set rs = Nothing
    Set cn = Nothing
errExit:
    Set rs = Nothing
    Set cn = Nothing
    Exit Sub
errHandle:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "Error"
    Resume errExit
End Sub
Function DefaultConnString() As String
     DataSource = App.Path & "\BarCodeData.mdb"
     DefaultConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
     DefaultConnString = DefaultConnString & DataSource
     DefaultConnString = DefaultConnString & ";Persist Security Info=True;Jet OLEDB:database password="
End Function

'*************************从数据库读数据***************************************************************

 
Public Sub Getdata(sqlStr As String, data() As String)
On Error GoTo errHandle
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i, j, h, k As Integer
    
    '**************初始化并打开数据库****************************************************************************
    Set cn = New ADODB.Connection
    cn.ConnectionString = DefaultConnString
    Set rs = New ADODB.Recordset
    cn.Open
    rs.Open sqlStr, cn, adOpenStatic, adLockReadOnly
    '**************得到行与列的数量******************************************************************************
    j = rs.Fields.Count - 1
    If rs.RecordCount <> 0 Then
    h = rs.RecordCount - 1
    ReDim data(h, j) As String
     
   '***************获取数据 ************************************************************************************
    While Not (rs.EOF)
        For i = 0 To rs.Fields.Count - 1
        If rs.Fields(i).Name <> "ID" Then
        data(k, i - 1) = rs.Fields(i).Value
        End If
        Next i
        k = k + 1
        rs.MoveNext
    Wend
    
    rs.Close
    cn.Close
    
    Set rs = Nothing
    Set cn = Nothing
errExit:
    Set rs = Nothing
    Set cn = Nothing
    Exit Sub
errHandle:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "Error"
    Resume errExit
    Else
    MsgBox "没有查询到数据！", vbOKOnly + vbInformation, "提示"
    End If
End Sub

Public Sub GetColumnNames(ColumnNames() As String)
On Error GoTo errHandle
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i, j As Integer
    Set cn = New ADODB.Connection
    cn.ConnectionString = DefaultConnString
    
    Set rs = New ADODB.Recordset
    sqlStr = "select * from BarCodeData"
    
    cn.Open
    rs.Open sqlStr, cn, adOpenStatic, adLockReadOnly
    
    j = rs.Fields.Count - 1
    ReDim ColumnNames(j) As String
    For i = 0 To rs.Fields.Count - 1
        ColumnNames(i) = rs.Fields(i).Name
        Next i
    
    rs.Close
    cn.Close
    
    Set rs = Nothing
    Set cn = Nothing
errExit:
    Set rs = Nothing
    Set cn = Nothing
    Exit Sub
errHandle:
    MsgBox Err.Description, vbOKOnly + vbExclamation, "Error"
    Resume errExit
End Sub