在Excel在用ADO读写数据库

Function GetConnStr() As String
    Dim strCn As String
    Dim server As String
    Dim database As String
    Dim user As String
    Dim pwd As String
   
    Dim obj As Object
    Set obj = Sheets("Ctrl")
    server = obj.Range("DBServer").Text
    database = obj.Range("Database").Text
    user = obj.Range("User").Text
    pwd = obj.Range("Password").Text
   
    strCn = "driver=DRIVER={MySql ODBC 5.1 Driver};" _
        & "server=" & server _
        & ";Uid=" & user _
        & ";Pwd=" & pwd _
        & ";Database=" & database
       
    GetConnStr = strCn
    '"Provider=MSDAORA.1;Data Source=ORCL;User ID=scott;Password=tiger;Persist Security Info=True"
End Function



Function InitFirstRow(sheet As Object)
' set font, interior, first row's style
    Dim obj As Object
    Set obj = sheet.Cells.Font
   
    obj.Name = "Calibri"
    obj.Size = 12

   
    Set obj = sheet.Rows("1:1")
    obj.RowHeight = 37
    obj.Font.Bold = True
    obj.AutoFilter
    obj.WrapText = True
   
    obj.Interior.ColorIndex = 37
    obj.Interior.Pattern = xlSolid
   
    sheet.Activate
    With ActiveWindow
        .SplitColumn = 2
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
   
End Function

Function GetDataRowCount(sheet As Object) As Integer
    Dim obj As Object
    Set obj = sheet.Cells
    Dim i As Integer
    i = 0
    Do
        If obj.Range("A1").Offset(i).Text = "" Then Exit Do
        i = i + 1
    Loop
    GetDataRowCount = i
End Function

Sub CreateResourceTab()

    Dim conn As New ADODB.Connection          ' 定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用
    Dim strCn As String, strSql As String
   
    strSql = "create table Resource(ID  int,EnglishName varchar(40),StartDate varchar(20),AssignedSOW varchar(100),TL  varchar(40),Status  varchar(200));"
   
    strCn = GetConnStr()
    conn.Open strCn
   
    If conn Is Nothing Then
        MsgBox "连接失败" & conn.Errors(0).Description
        Return
    End If
   
    conn.Execute strSql
    conn.Close
   
End Sub


Sub ReadData()

    Dim i As Integer, j As Integer, sht As Worksheet 'i,j为整数变量；sht 为excel工作表对象变量，指向某一工作表
    Dim cn As New ADODB.Connection '定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用
    Dim rs As New ADODB.Recordset '定义记录集对象，保存数据表
    Dim strCn As String, strSql As String '字符串变量
   
   
    strCn = GetConnStr()
   
    '下面的语句将读取数据表数据，并将它保存到excel工作表中：画两张表想像一下，工作表为一张两维表，记录集也是一张两维表
    strSql = "select * from Resource"    '定义SQL查询命令字符串
    cn.Open strCn                       '与数据库建立连接，如果成功，返回连接对象cn
    rs.Open strSql, cn                  '执行strSQL所含的SQL命令，结果保存在rs记录集对象中
   
   
    Set sht = ThisWorkbook.Worksheets("DesTab")   '把sht指向当前工作簿的sheet1工作表
    ' delete all data
    sht.Cells.Delete Shift:=xlUp
    sht.Cells(1, 1) = "No."
    sht.Cells(1, 2) = "English Name"
    sht.Cells(1, 3) = "Start Date"
    sht.Cells(1, 4) = "Assigned SOW"
    sht.Cells(1, 5) = "TL"
    sht.Cells(1, 6) = "Status"
   
    i = 2
   
    Do While Not rs.EOF     '当数据指针未移到记录集末尾时，循环下列操作
        sht.Cells(i, 1) = rs("ID")    '把当前记录的字段1的值保存到sheet1工作表的第i行第1列
        sht.Cells(i, 2) = rs("EnglishName")    '把当前字段2的值保存到sheet1工作表的第i行第2列
        sht.Cells(i, 3) = rs("StartDate")
        sht.Cells(i, 4) = rs("AssignedSOW")
        sht.Cells(i, 5) = rs("TL")
        sht.Cells(i, 6) = rs("Status")
   
        rs.MoveNext                      '把指针移向下一条记录
        i = i + 1                        'i加1，准备把下一记录相关字段的值保存到工作表的下一行
    Loop                                 '循环
   
    rs.Close   '关闭记录集，至此，程序将把某数据表的字段1和字段2保存在excel工作表sheet1的第1、2列，行数等于数据表的记录数

    InitFirstRow sht
   
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
   
    sht.Activate
    ThisWorkbook.Save
   
    MsgBox "Read " & (i - 2) & " records"
   
End Sub

Sub SaveData()

    Dim i As Integer, j As Integer          ' i,j为整数变量；
    Dim sht As Worksheet                    ' sht 为excel工作表对象变量，指向某一工作表
    Dim cn As New ADODB.Connection          ' 定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用
    Dim strCn As String, strSql As String   ' 字符串变量

    strCn = GetConnStr()

    Set sht = ThisWorkbook.Worksheets("SrcTab")   '把sht指向当前工作簿的sheet1工作表
    sht.ClearArrows
   
    cn.Open strCn                       '与数据库建立连接，如果成功，返回连接对象cn
   
    j = GetDataRowCount(sht)
   
    For i = 2 To j    '循环开始，构造SQL命令
        strSql = "insert into Resource(ID, EnglishName, StartDate, AssignedSOW, TL, Status) " _
            & "values( " _
            & sht.Cells(i, 1) _
            & ",'" & sht.Cells(i, 2) _
            & "','" & sht.Cells(i, 3) _
            & "','" & sht.Cells(i, 4) _
            & "','" & sht.Cells(i, 5) _
            & "','" & sht.Cells(i, 6) & "');"

        '执行SQL
        cn.Execute strSql
        
    Next

    cn.Close '关闭数据库链接,释放资源
    MsgBox "Insert " & (j - 1) & " records"
End Sub


Sub DeleteData()
    Dim cn As New ADODB.Connection          ' 定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用
    Dim strCn As String, strSql As String   ' 字符串变量
   
    strSql = "delete from Resource"    '定义SQL查询命令字符串

    strCn = GetConnStr()
    cn.Open strCn                       '与数据库建立连接，如果成功，返回连接对象cn
   
    cn.Execute strSql
    cn.Close
   
End Sub


Public Function Conn_SqlServer(ByVal serverIP As String, _
    userid As String, _
    password As String, _
    database As String) As Connection
   
    Dim sConStr As String
    sConStr = "driver=sql server;" _
    & "server=" & serverIP _
    & ";Uid=" & userid _
    & ";Pwd=" & password _
    & ";Database=" & database
   
    Dim conn As New ADODB.Connection
    conn.Open sConStr
   
    If conn Is Nothing Then
        MsgBox "连接已关闭"
        Exit Function
    Else
        MsgBox "连接成功"
        Conn_SqlServer = conn
    End If

End Function

Public Function closeConnection(ByVal conn As Connection)
If conn Is Nothing Then
    MsgBox "连接已关闭"
Else
    conn.Close
    MsgBox "连接关闭成功"
End If
End Function


Sub TestConn()
    Dim conn As New ADODB.Connection
    conn = Conn_SqlServer("Y012593/sqlexpress", "sa", "!sa2010", "happy")
    Call closeConnection(conn)
   
End Sub


Sub TestOracleConnect()
    Dim cn As ADODB.Connection
    Dim rs As New ADODB.Recordset '定义记录集对象，保存数据表
    Dim strSql As String
   

    strSql = "select sysdate from dual"
   
    Set cn = New ADODB.Connection
   
    cn.Open "Provider=MSDAORA.1;Data Source=ORCL;User ID=scott;Password=tiger;Persist Security Info=True"

    If cn Is Nothing Then
        MsgBox "连接已关闭"
        Return
    End If
   
    rs.Open strSql, cn                  '执行strSQL所含的SQL命令，结果保存在rs记录集对象中
   
    strSql = rs("sysdate")    '把当前记录的字段1的值保存到sheet1工作表的第i行第1列
    MsgBox "连接成功，当前时间为： " & strSql
   
    rs.Close   '关闭记录集，至此，程序将把某数据表的字段1和字段2保存在excel工作表sheet1的第1、2列，行数等于数据表的记录数
   
    cn.Close
   
End Sub