Excel数据操作模块

Option Explicit'获取字段数据通过字段名（字符型索引）Public Function GetEncryptDataForStrField(ByVal tableName As String, _    ByVal fieldname As String, _    ByVal expfield As String, _    ByVal e_str As String) As String    Dim ret As String    ret = GetDataForField(tableName, fieldname, expfield, e_str)    GetEncryptDataForStrField = ret    End Function'获取字段数据通过字段名（整型索引）Public Function GetEncryptDataForIntField(ByVal tableName As String, _    ByVal fieldname As String, _    ByVal expfield As String, _    ByVal e_int As Integer) As String    Dim ret As String    ret = GetDataForField(tableName, fieldname, expfield, e_int)    GetEncryptDataForIntField = ret    End Function'获取数据字段内容Public Function GetDataForField1(ByVal tableName As String, _                                    ByVal fieldname As String, _                                    ByVal expfield As String, _                                    ByVal expfieldvalue As String) As String                                    Dim conn As New ADODB.Connection    Dim dbo As New DataOperate        Set conn = dbo.GetConnExcel        Dim Sql As String    Sql = dbo.GetQuerySQLString(tableName, "a", "f", "*", expfield & "='" & expfieldvalue & "'")        Dim rs As ADODB.Recordset    Set rs = dbo.ExecuteQuery(conn, Sql)        Dim ret As String        With rs                If Not rs.EOF Then            ret = rs(fieldname).value        End If        End With        rs.Close    Set rs = Nothing    conn.Close    Set conn = Nothing        GetDataForField1 = ret    End Function    '获取数据字段内容Public Function GetDataForField(ByVal tableName As String, _                                ByVal fieldname As String, _                                ByVal expfield As String, _                                ByVal expfieldvalue As String) As String        Dim rng As Range    Dim col1, col2, row As Integer    Set rng = ThisWorkbook.RngFind(fieldname, Sheets(tableName).Range("a1:z1"))    If Not rng Is Nothing Then        col1 = rng.Column    Else        Exit Function    End If    Set rng = ThisWorkbook.RngFind(expfield, Sheets(tableName).Range("a1:z1"))    If Not rng Is Nothing Then        col2 = rng.Column    Else        Exit Function    End If    Set rng = ThisWorkbook.RngFind(expfieldvalue, _                Application.Range(Sheets(tableName).Cells(2, col2), _                                    Sheets(tableName).Cells(100, col2)))    If Not rng Is Nothing Then        row = rng.row    Else        Exit Function    End If        Dim ret As String    ret = Sheets(tableName).Cells(row, col1).value    GetDataForField = ret    End Function    '设置数据字段内容Public Function SetDataForField(ByVal tableName As String, _                                ByVal fieldname As String, _                                ByVal expfield As String, _                                ByVal expfieldvalue As String, _                                ByVal value As String) As Integer        Dim rng As Range    Dim col1, col2, row As Integer    Set rng = ThisWorkbook.RngFind(fieldname, Sheets(tableName).Range("a1:z1"))    If Not rng Is Nothing Then        col1 = rng.Column    Else        SetDataForField = 0        Exit Function    End If    Set rng = ThisWorkbook.RngFind(expfield, Sheets(tableName).Range("a1:z1"))    If Not rng Is Nothing Then        col2 = rng.Column    Else        SetDataForField = 0        Exit Function    End If    Set rng = ThisWorkbook.RngFind(expfieldvalue, _                Application.Range(Sheets(tableName).Cells(2, col2), _                                    Sheets(tableName).Cells(100, col2)))    If Not rng Is Nothing Then        row = rng.row    Else        SetDataForField = 0        Exit Function    End If        Sheets(tableName).Cells(row, col1).value = value    SetDataForField = 1    End Function    '获取密码对照表Public Function GetEncrptCharNumTableForUid(ByVal uId As Integer) As String()        Dim s1, s2, s3, str As String    s1 = GetEncryptDataForIntField("xtpass", "xhdzb1", "uid", uId)    s2 = GetEncryptDataForIntField("xtpass", "xhdzb2", "uid", uId)    s3 = GetEncryptDataForIntField("xtpass", "xhdzb3", "uid", uId)        str = Trim(s1) & " " & Trim(s2) & " " & Trim(s3)    str = Replace(str, "  ", " ")    GetEncrptCharNumTableForUid = Split(str)    End Function'获取密码对照表Public Function GetEncrptCharNumStringForUid(ByVal uId As Integer) As String    Dim s1, s2, s3, str As String    s1 = GetEncryptDataForIntField("xtpass", "xhdzb1", "uid", uId)    s2 = GetEncryptDataForIntField("xtpass", "xhdzb2", "uid", uId)    s3 = GetEncryptDataForIntField("xtpass", "xhdzb3", "uid", uId)        str = Trim(s1) & " " & Trim(s2) & " " & Trim(s3)    str = Replace(str, "  ", " ")    GetEncrptCharNumStringForUid = strEnd Function'获取密码对照表Public Function GetEncrptCharNumTable(ByVal str As String) As String    GetEncrptCharNumTable = Trim(Split(Mid(str, 2, Len(str) - 2), ",")(2))End Function'获取加密随机数Public Function GetEncryptRndNumForUid(ByVal uId As Integer) As Integer    Dim s_id As String    s_id = GetEncryptDataForIntField("xtpass", "i_rnd", "uid", uId)        If s_id = "" Then        GetEncryptRndNumForUid = 0    Else        GetEncryptRndNumForUid = CInt(s_id)    End IfEnd Function'获取加密随机数Public Function GetEncryptRndNum(ByVal str As String) As Integer    GetEncryptRndNum = Split(Mid(str, 2, Len(str) - 2), ",")(0)End Function'获取加密或解密字符Public Function GetEncryptStringForUid(ByVal uId As Integer) As String    GetEncryptStringForUid = GetEncryptDataForIntField("userpass", "password", "uid", uId)End Function'获取加密或解密字符Public Function GetEncryptString(ByVal str As String) As String    GetEncryptString = Split(Mid(str, 2, Len(str) - 2), ",")(1)End Function'添加新用户记录Public Function AddNewRecord(ByVal uName As String, _            ByVal uId As Integer, _            ByVal regdate As Date, _            ByVal Privileges As String)    Dim dbo As New DataOperate    Dim conn As New ADODB.Connection    Set conn = dbo.GetConnExcel        Dim Sql As String    Sql = dbo.GetQuerySQLString("userinf", "a", "f", "*", "")        Dim rs As ADODB.Recordset    Set rs = dbo.ExecuteQuery(conn, Sql)        Dim ret As String        With rs            If Not rs.EOF Then .MoveFirst                .AddNew                !uId = uId        !uName = uName        !regdate = regdate        !Privileges = Privileges                .Update            End With        rs.Close    Set rs = Nothing    conn.Close    Set conn = Nothing    End Function'获取最大用户IDPublic Function GetMaxIid() As Integer    Dim dbo As New DataOperate    Dim conn As New ADODB.Connection    Set conn = dbo.GetConnExcel        Dim Sql As String    Sql = dbo.GetQuerySQLString("userinf", "a", "f", "*", "")        Dim rs As ADODB.Recordset    Set rs = dbo.ExecuteQuery(conn, Sql)        Dim maxid As Integer    maxid = 0        With rs            Do Until rs.EOF            If rs("uid").value > maxid Thenmaxid = rs("uid").value            End If            rs.MoveNext        Loop            End With        rs.Close    Set rs = Nothing    conn.Close    Set conn = Nothing        GetMaxIid = maxid    End Function'获取更新用户密码Public Function UpdataUPwd(ByVal uId As Integer, ByVal pwd As String)    Dim dbo As New DataOperate    Dim conn As New ADODB.Connection    Set conn = dbo.GetConnExcel        Dim Sql As String    Sql = dbo.GetQuerySQLString("userpass", "a", "f", "*", "uid='" & uId & "'")        Dim rs As ADODB.Recordset    Set rs = dbo.ExecuteQuery(conn, Sql)        With rs                        If Not rs.EOF Then                        !Password = pwd            .Update                End If            End With        'rs.Close    Set rs = Nothing    conn.Close    Set conn = Nothing        End Function'设置新用户密码档案'pwdstr需要是三段字符串，含随机数、加密对照表、密码字符Public Function AddNewUserPwd(ByVal uId As Integer, ByVal pwdstr As String)    Dim dbo As New DataOperate    Dim conn As New ADODB.Connection    Set conn = dbo.GetConnExcel        Dim Sql As String    Sql = dbo.GetQuerySQLString("xtpass", "a", "f", "*", "")        Dim rs As ADODB.Recordset        Set rs = dbo.ExecuteQuery(conn, Sql)            Dim a_xhb() As String        a_xhb = Split(Mid(Split(pwdstr, ",")(2), 1, Len(Split(pwdstr, ",")(2)) - 1))    Dim xhb1, xhb2, xhb3 As String        xhb1 = ""    xhb2 = ""    xhb3 = ""        Dim i_xhb As Integer    i_xhb = Int(UBound(a_xhb) / 3)        Dim i        For i = 0 To UBound(a_xhb)        If i < i_xhb Then            xhb1 = xhb1 & a_xhb(i) & " "        ElseIf i < i_xhb * 2 Then            xhb2 = xhb2 & a_xhb(i) & " "        Else            xhb3 = xhb3 & a_xhb(i) & " "        End If            Next       With rs        '.MoveFirst        .AddNew        !uId = uId        !i_rnd = UserAdmin.GetEncryptRndNum(pwdstr)                !xhdzb1 = xhb1        !xhdzb2 = xhb2        !xhdzb3 = xhb3                !mmsj = Date        .Update    End With    Set rs = Nothing        Sql = dbo.GetQuerySQLString("userpass", "a", "f", "*", "")        Set rs = dbo.ExecuteQuery(conn, Sql)        With rs                .AddNew        !uId = uId        !Password = UserAdmin.GetEncryptString(pwdstr)        !mmsj = Date        .Update        End With        rs.Close    Set rs = Nothing    conn.Close        Set conn = Nothing        End Function'删除用户记录Public Function DelUserRecord(ByVal uId As Integer)    Dim dbo As New DataOperate    Dim conn As New ADODB.Connection    Set conn = dbo.GetConnExcel1        Dim Sql As String    Sql = dbo.GetQuerySQLString("userinf", "a", "f", "*", "uid='" & uId & "'")        Dim rs As ADODB.Recordset    Set rs = dbo.ExecuteQuery(conn, Sql)        Dim ret As String        With rs            If rs.EOF Then Exit Function                !uId = ""        !uName = ""        !regdate = ""        !Privileges = ""                .Update            End With        rs.Close    Set rs = Nothing    conn.Close    Set conn = Nothing    End Function'删除用户记录Public Function DelUserRecord2(ByVal uId As Integer)            Dim c As Range        With ThisWorkbook.Sheets("userinf").Range("a1:a500")                Set c = .Find(uId, LookIn:=xlValues)        If Not c Is Nothing Then                        ThisWorkbook.Sheets("userinf").Rows(c.row()).Delete                End If    End With    With ThisWorkbook.Sheets("userpass").Range("a1:a500")                Set c = .Find(uId, LookIn:=xlValues)        If Not c Is Nothing Then                        ThisWorkbook.Sheets("userpass").Rows(c.row()).Delete                End If    End With    With ThisWorkbook.Sheets("xtpass").Range("a1:a500")                Set c = .Find(uId, LookIn:=xlValues)        If Not c Is Nothing Then                        ThisWorkbook.Sheets("xtpass").Rows(c.row()).Delete                End If    End WithEnd Function'获取用户Id通过用户名查找Public Function FindUserIdForUName(ByVal uName As String) As String        Dim s_uid As String    s_uid = GetDataForField("userinf", "uid", "uname", uName)    FindUserIdForUName = s_uid    End Function'获取用户权限通过Id查找Public Function GetUserPrivilegesForId(ByVal uId As Integer) As String        Dim priv As String    priv = GetDataForField("userinf", "Privileges", "uid", uId)    GetUserPrivilegesForId = priv    End Function'从一个表查查询字段数据Public Function FindData(ByVal sheetName As String, ByVal fieldIndex As String) As String    Dim r As Range    With Sheets(sheetName).Range("b2:b500")        Set r = .Find(fieldIndex, LookIn:=xlValues)        If Not r Is Nothing Then            FindData = Sheets(sheetName).Cells(r.row, 3).value        End If    End WithEnd Function