自用Excel VBA函数整理 part2

执行ADO SQL（参数可为1维Array或Range）： 

Public Function ExecuteSQLCmd(conn As ADODB.Connection, cmd As ADODB.Command, ByRef rowsAffected, Optional paramArrayOrRng) As ADODB.Recordset
    If cmd.Parameters.Count > 0 Then
        For i = cmd.Parameters.Count - 1 To 0 Step -1
            cmd.Parameters.Delete i
        Next i
    End If
    cmd.ActiveConnection = conn
    
    If Not (IsMissing(paramArrayOrRng) Or IsEmpty(paramArrayOrRng)) Then
        cmd.Prepared = True
        If IsObject(paramArrayOrRng) Then
            If TypeName(paramArrayOrRng) = "Range" Then
                For Each cell In paramArrayOrRng.Cells
                    v = cell.value
                    cmd.Parameters.Append CreateDbParameter(v)
                Next cell
            Else    'could be Collection etc.
                For Each cell In paramArrayOrRng
                    v = cell.value
                    cmd.Parameters.Append CreateDbParameter(v)
                Next cell
            End If
        ElseIf IsArray(paramArrayOrRng) Then
            For Each v In paramArrayOrRng
                cmd.Parameters.Append CreateDbParameter(v)
            Next v
        Else
            cmd.Parameters.Append CreateDbParameter(paramArrayOrRng)
        End If
    Else
        cmd.Prepared = False
    End If
    
    Dim rs As ADODB.Recordset
    Set rs = cmd.Execute(ra)
    Set ExecuteSQLCmd = rs
End Function

Private Function CreateDbParameter(v) As ADODB.Parameter
    t = ADODB.DataTypeEnum.adVariant
    Select Case TypeName(v)
        Case "String"
            t = ADODB.DataTypeEnum.adVarChar
        Case "Integer"
            t = ADODB.DataTypeEnum.adInteger
        Case "Double"
            t = ADODB.DataTypeEnum.adDouble
        Case "Date"
            t = ADODB.DataTypeEnum.adDate
    End Select
    
    Dim p As New ADODB.Parameter
    p.Type = t
    If t = ADODB.DataTypeEnum.adVarChar Then p.Size = Len(v) * 2 'for non-ascii
    p.value = IIf(IsEmpty(v), Null, v)
    p.Direction = adParamInput
    Set CreateDbParameter = p
End Function

Public Function ExecuteSQL(conn As ADODB.Connection, sqlTxt, ByRef rowsAffected, Optional paramArrayOrRng) As ADODB.Recordset
    Dim cmd As New ADODB.Command
    cmd.CommandText = sqlTxt
    
    Set ExecuteSQL = ExecuteSQLCmd(conn, cmd, ra, paramArrayOrRng)
End Function

Public Function ExecuteSP(conn As ADODB.Connection, spName, ByRef rowsAffected, Optional paramArrayOrRng) As ADODB.Recordset
    Dim cmd As New ADODB.Command
    cmd.CommandText = spName
    cmd.CommandType = ADODB.adCmdStoredProc
    
    Set ExecuteSP = ExecuteSQLCmd(conn, cmd, ra, paramArrayOrRng)
End Function

Public Sub CopyFromRecordset(cellTopLeft As Range, rs As Recordset)
    For i = 0 To (rs.Fields.Count - 1)
        cellTopLeft.Offset(0, i) = rs.Fields(i).Name
    Next
    cellTopLeft.Offset(1, 0).CopyFromRecordset rs
End Sub

Public Sub CopyRecordRow(cell As Range, rs As Recordset, Optional colStart, Optional colEnd)
    l = IIf(IsMissing(colStart), 0, colStart)
    u = IIf(IsMissing(colEnd), rs.Fields.Count - 1, colEnd)
    For i = l To u
        cell.Offset(0, i - l) = rs(i)
    Next
End Sub

ExecuteSQLCmd，CreateDbParameter 等