VBA与数据库——写个类操作ADO_写入

'插入数据
Function InsertDB() As RetCode
    '选择数据源，检查标题
    Dim rngsrc As Range
    If SelectDataAndCheckField(rngsrc) = ErrRT Then
        InsertDB = ErrRT
        Exit Function
    End If
    Dim srcArr() As Variant
    srcArr = rngsrc.Value

    Dim rng As Range
    '需要插入的列对应的Fields的下表
    Dim colInsert() As Long, colInsertName() As String
    ReDim colInsert(UBound(srcArr, 2) - 1) As Long
    ReDim colInsertName(UBound(srcArr, 2) - 1) As String
    
    Dim i As Long, j As Long
    For i = 1 To UBound(srcArr, 2)
        For j = 0 To DB_Info.ActiveTable.FieldsCount - 1
            If srcArr(1, i) = DB_Info.ActiveTable.Fields(j).SName Then
                colInsert(i - 1) = j
                colInsertName(i - 1) = DB_Info.ActiveTable.Fields(j).SName
                Exit For
            End If
        Next j
        
        If j = DB_Info.ActiveTable.FieldsCount Then
            MsgBox "不能存在的列：" & srcArr(1, i)
            InsertDB = ErrRT
            Exit Function
        End If
    Next i
    
    Dim strsql As String
    strsql = "insert into " + DB_Info.ActiveTable.SName + "(" + VBA.Join(colInsertName, ",") + ") values ("
    
    If DB_Info.db.Begin Then
        MsgBox DB_Info.db.GetErr
        InsertDB = ErrRT
        Exit Function
    End If
            
    Dim sqlvalues() As String
    ReDim sqlvalues(UBound(srcArr, 2) - 1) As String
    For i = 2 To UBound(srcArr)
        'x , y
        For j = 0 To UBound(colInsert)
            sqlvalues(j) = MPublic.GetFieldValueInSql(srcArr(i, j + 1), DB_Info.ActiveTable.Fields(colInsert(j)).sType)
        Next
        
        If DB_Info.db.ExecuteNonQuery(strsql + VBA.Join(sqlvalues, ",") + ")") Then
            MsgBox DB_Info.db.GetErr
            DB_Info.db.Rollback
            InsertDB = ErrRT
            Exit Function
        End If
    Next
    DB_Info.db.Commit

    MsgBox "OK"
    InsertDB = SuccRT
End Function

'更新数据
'colsWhere   条件所在列（ID、或者主键等），对应的是单元格
Function UpdateDB(colswhere() As Long) As RetCode
    '选择数据源，检查标题
    Dim rngsrc As Range
    If SelectDataAndCheckField(rngsrc) = ErrRT Then
        UpdateDB = ErrRT
        Exit Function
    End If

    '输入需要更新数据的列
    Dim rngs As Range
    On Error Resume Next
    Set rngs = Application.InputBox("选择需要更新数据所在的列，按Ctrl多选，只能选择第一行所在单元格。", Default:=ActiveCell.Address, Type:=8)
    On Error GoTo 0
    If rngs Is Nothing Then Exit Function

    Dim rng As Range
    '需要更新的列
    Dim colUpdate() As Long
    Dim kColUpdate As Long
    For Each rng In rngs
        If rng.Row = 1 Then
            ReDim Preserve colUpdate(kColUpdate) As Long
            colUpdate(kColUpdate) = rng.Column
            kColUpdate = kColUpdate + 1
        End If
    Next
    If kColUpdate = 0 Then
        MsgBox "没有选择满足要求的更新列。"
        UpdateDB = ErrRT
        Exit Function
    End If
    
    
    Dim srcArr() As Variant
    srcArr = rngsrc.Value
    
    Dim i As Long, j As Long
    Dim sqlcmd As String
    ReDim sqlwhere(UBound(colswhere)) As String

    Dim updatefield() As String
    ReDim updatefield(kColUpdate - 1) As String
    
    If DB_Info.db.Begin Then
        MsgBox DB_Info.db.GetErr
        UpdateDB = ErrRT
        Exit Function
    End If
            
    For i = 2 To UBound(srcArr)
        'set F1=x and F2 = x
        For j = 0 To kColUpdate - 1
            updatefield(j) = DB_Info.ActiveTable.Fields(colUpdate(j) - 1).SName & "=" & MPublic.GetFieldValueInSql(srcArr(i, colUpdate(j)), DB_Info.ActiveTable.Fields(colUpdate(j) - 1).sType)
        Next
        
        For j = 0 To UBound(colswhere)
            sqlwhere(j) = DB_Info.ActiveTable.Fields(colswhere(j) - 1).SName & "=" & MPublic.GetFieldValueInSql(srcArr(i, colswhere(j)), DB_Info.ActiveTable.Fields(colswhere(j) - 1).sType)
        Next
        
        sqlcmd = "update " & DB_Info.ActiveTable.SName & " set " & VBA.Join(updatefield, ",") & " where " & VBA.Join(sqlwhere, " and ")
        If DB_Info.db.ExecuteNonQuery(sqlcmd) Then
            MsgBox DB_Info.db.GetErr
            DB_Info.db.Rollback
            UpdateDB = ErrRT
            Exit Function
        End If
    Next
    DB_Info.db.Commit
    
    MsgBox "OK"
End Function