读、写（追加）access表的函数

时　间:2010-11-02 15:13:44
作　者:btianry   ID：15117  城市：铁岭
摘　要:读、写（追加）Access的函数
正　文:

'在标准模块中写入如下代码：
Function MDBRead(theTable As String, theFields As String, Optional theWhere As String = "", Optional theType As String = "One") As Variant
'作  用：   根据theWhere参数返回 theTable表 中，指定theFields字段的，一个或全部值
'参  数：   theTable    表名；
'           theFields   字段名，读取多个字段时，字段间使用逗号（,）间隔
'           theWhere    条件
'           theType     读取类型,(参数值为“One”时，表示只读取符合theWhere的第一条记录；为“All”时，表示读取符合theWhere的所有记录）
'返回值：
'如果参数theType 值为 "One"（或参数theType 值为"All",但参数theFidlds只有一个字段）时,MDBRead返回一个一维数组,否则MDBRead返回二维数组或单个值
'
'如果没有找到指定记录则返回 Null
'
'返回的二维数组规定:(x,y) x.表示记录数,y.表示字段号
'注  意：
'函数读取Access中的表均为链接表，如果是本地表时，需要将下面：
'    Set rst = CurrentDb.OpenRecordset(theTable, , dbReadOnly)
'改为：
'    Set rst = CurrentDb.OpenRecordset(theTable, dbOpenDynaset, dbReadOnly)
'
Dim rst As Recordset, dimFields As Variant, dimvalue() As Variant, thenum As Long, i As Long, j As Long, theNum2 As Long
'1为记录源；2为多字段数组；4为中间结果；5为计数变量
    dimFields = Split(theFields, ",")   '得到字段名数组
    thenum = UBound(dimFields)          '得到该数组大小
    theNum2 = DCount("*", theTable, theWhere)
    If theNum2 = 0 Then                 '如果没有符合条件的记录，则退出本函数
        MDBRead = Null
        Exit Function
    End If
    If UCase(theType) = "ONE" Then     '根据参数theType来重新规定数组,尽量定义为一维；不允许时,定义2维
        ReDim dimvalue(thenum)
    ElseIf UCase(theType) = "ALL" And thenum = 0 Then
        ReDim dimvalue(theNum2 - 1)
    Else
        ReDim dimvalue(theNum2 - 1, thenum)
    End If
    '连接数据库中的链接表
    Set rst = CurrentDb.OpenRecordset(theTable, , dbReadOnly)
    If theWhere = "" Then rst.MoveFirst Else rst.FindFirst theWhere '根据条件查找记录
    '根据参数theType来为中间结果取值
    If Not rst.NoMatch And UCase(theType) = "ONE" Then                     'theType为One时
        For i = 0 To thenum
             dimvalue(i) = rst(dimFields(i))
        Next i
        If thenum = 0 Then MDBRead = dimvalue(0) Else MDBRead = dimvalue   '如果结果为1时，返回单个值，否则，返回数组
    ElseIf Not rst.NoMatch And UCase(theType) = "ALL" Then                 'theType为All时
        Do
            For i = 0 To thenum
                If thenum = 0 Then dimvalue(j) = rst(dimFields(i)) Else dimvalue(j, i) = rst(dimFields(i))
            Next i
            rst.FindNext theWhere
            j = j + 1
        Loop Until rst.NoMatch
        If thenum = 0 And theNum2 = 1 Then MDBRead = dimvalue(0) Else MDBRead = dimvalue   '如果结果为1时，返回单个值，否则，返回数组
    Else
        MDBRead = Null
    End If
    rst.Close
    Set rst = Nothing
End Function

'写Access表的函数：

Sub MDBUpdate(theTable As String, theFields As Variant, theNewValue As Variant, Optional theWhere As String = "", Optional theLeiBie As Byte = 0)
'作  用：   利用theFields参数和theNewValue参数，及theTable参数构造SQL更新查询（或追加查询）来更新记录，（或在表中追加一条记录）
'参  数：   theTable    表名；
'           theFields   字段名，读取多个字段时，字段间使用逗号（,）间隔
'           theWhere    条件
'           theNewValue 字段的新值，数量应于参数theFields的个数对应，各个值之间使用逗号（,）间隔
'           theLeiBie   类型(0,更新；1,新记录)
'
'返回值：   子过程非函数，无返回值
'注  意：theNewValue 参数有以下2点要求：

'1.日期间隔用“/”，例如：2010/9/8

'2.文本类型值不能含有逗号（,）

Dim dimFields As Variant, dimvalue As Variant, thenum As Variant, i As Long
'1为字段；2为新值；3为临时变量；4为计数器变量
On Error GoTo therr
    dimFields = Split(theFields, ",")
    dimvalue = Split(theNewValue, ",")
    '循环检查 新值变量内容 ,如果是 日期型 ,前后加 "#" , 否则 前后加 "'"
    For i = 0 To UBound(dimFields)
        If IsDate(dimvalue(i)) And InStr(dimvalue(i), "/") > 0 Then
            dimvalue(i) = "#" & dimvalue(i) & "#"
        Else
            dimvalue(i) = "'" & dimvalue(i) & "'"
        End If
    Next i
    '关闭 系统警告
    DoCmd.SetWarnings False
    If theLeiBie = 0 Then
        For i = 0 To UBound(dimFields)
            If i = 0 Then
                thenum = dimFields(i) & " = " & dimvalue(i)
            Else
                thenum = thenum & " ," & dimFields(i) & " = " & dimvalue(i)
            End If
        Next i
        '运行SQL语句
        DoCmd.RunSQL "Update " & theTable & " SET " & thenum & " Where " & theWhere
    Else
        For i = 0 To UBound(dimFields)
            If i = 0 Then
                thenum = dimvalue(i)
            Else
                thenum = thenum & ", " & dimvalue(i)
            End If
        Next i
        '运行SQL语句
        DoCmd.RunSQL "Insert INTO " & theTable & " ( " & theFields & " ) VALUES (" & thenum & " )"
    End If
    '打开系统警告
    DoCmd.SetWarnings True
bye:
    Exit Sub
therr:
    MsgBox err.Number & "  " & err.Description & vbCrLf _
    & "错误在: MDBUpdate " & IIf(theLeiBie = 0, "Update " & theTable & " SET " & thenum & " Where " & theWhere, "Insert INTO " & theTable & " ( " & theFields & " ) VALUES (" & thenum & ")")
    GoTo bye
End Sub

以上为2个函数，以下是示例：

读取某头猪状态日期的值，并存放在变量theTempData1 中：

Dim theTempData1 As Variant
    theTempData1 = MDBRead("猪群档案表", "状态日期", "[ID]=" & Me.Combo母猪)

当 Combo母猪列表框 控件中写入了其中没有的值时，进行检查，并用MsgBox显示之：
Private Sub Combo母猪_NotInList(NewData As String, Response As Integer)
    If IsNull(MDBRead("猪群档案表", "状态", "[耳号]='" & NewData & "'")) Then
        MsgBox "输入错误！本场尚无此母猪:" & NewData, vbCritical, strTitle
    Else
        MsgBox "状态错误！" & NewData & " 当前 " & MDBRead("选项表", "属性值", "[属性ID]=" & MDBRead("猪群档案表", "状态", "[耳号]='" & NewData & "'")) & " 了～", vbInformation, strTitle
    End If
    Response = acDataErrContinue
    Me.Combo母猪.Undo
End Sub

母猪返情后，修改其状态，状态日期的示例：

    '修改 猪群档案表 状态,状态日期
        MDBUpdate "猪群档案表", "状态,状态日期", "127," & Me.Text返情日期, "[ID]=" & Me.Combo母猪      ' 将母猪状态改为 空怀（127）

追加记录的示例：
    '记录 返情事件   '母猪事件为 返情（201)
        MDBUpdate "猪只事件处理记录表", "事件类别,事件日期,事件猪只ID,事件对应ID,前状态日期,事件记录,操作员", "201," & Me.Text返情日期 & "," & _
            Me.Combo母猪 & "," & Me!配种ID & "," & theTempData1 & ",返情：原因 " & IIf(IsNull(Me.Text返情原因), "未知", ChuLiStringComma(Me.Text返情原因)) & "," & ChaoZuoYuanName, , 1

※ ChuLiStringComma 函数，也可以写入到您的标准模块中，以下是定义：
Function ChuLiStringComma(theString As Variant) As String    '处理字符串中的逗号(，或,)
'作用:  将指定的字符串(theString)进进去逗号操作,使得theString在MDBUpdate函数的新值中,不会被认为是多个参数
'参数:  1.一个可能包含有逗号的字符串.
'返回:  不含逗号的字符串
'注意:  无
Dim dimvalue As Variant
    If IsNull(theString) Then theString = ""
    dimvalue = Split(theString, ",")
    If IsArray(dimvalue) Then
        ChuLiStringComma = Join(dimvalue, " ")
    Else
        ChuLiStringComma = theString
    End If
End Function