Sub GetDataFromSQLServer()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim strConn As String
    
    ' 创建连接和记录集对象
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    ' 连接字符串 - 根据实际情况修改
    strConn = "Provider=SQLOLEDB;Data Source=服务器名称或IP;" & _
              "Initial Catalog=数据库名称;User ID=用户名;Password=密码;"
    
    ' SQL查询语句
    strSQL = "SELECT * FROM 表名 WHERE 条件"
    
    ' 打开连接
    conn.Open strConn
    
    ' 执行查询
    Set rs = conn.Execute(strSQL)
    
    ' 将结果输出到Excel工作表
    Sheets("Sheet1").Range("A2").CopyFromRecordset rs
    
    ' 关闭连接
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
    
    MsgBox "数据获取完成!"
End Sub

Sub GetDataWithParameters()
    Dim conn As Object
    Dim cmd As Object
    Dim rs As Object
    Dim param As Object
    
    Set conn = CreateObject("ADODB.Connection")
    Set cmd = CreateObject("ADODB.Command")
    Set rs = CreateObject("ADODB.Recordset")
    
    conn.Open "Provider=SQLOLEDB;Data Source=服务器名称;Initial Catalog=数据库名称;User ID=用户名;Password=密码;"
    
    ' 创建命令对象
    Set cmd.ActiveConnection = conn
    cmd.CommandText = "SELECT * FROM 表名 WHERE 字段名 = ?"
    cmd.CommandType = 1 ' adCmdText
    
    ' 添加参数
    Set param = cmd.CreateParameter("param1", 200, 1, 50, "参数值") ' 200=adVarChar, 1=adParamInput
    cmd.Parameters.Append param
    
    ' 执行查询
    Set rs = cmd.Execute
    
    ' 处理结果...
    
    rs.Close
    conn.Close
    Set rs = Nothing
    Set cmd = Nothing
    Set conn = Nothing
End Sub

Sub CallStoredProcedure()
    Dim conn As Object
    Dim cmd As Object
    
    Set conn = CreateObject("ADODB.Connection")
    Set cmd = CreateObject("ADODB.Command")
    
    conn.Open "Provider=SQLOLEDB;Data Source=服务器名称;Initial Catalog=数据库名称;User ID=用户名;Password=密码;"
    
    Set cmd.ActiveConnection = conn
    cmd.CommandText = "存储过程名称"
    cmd.CommandType = 4 ' adCmdStoredProc
    
    ' 添加参数
    cmd.Parameters.Append cmd.CreateParameter("参数名", 数据类型, 方向, 大小, 值)
    
    ' 执行存储过程
    cmd.Execute
    
    conn.Close
    Set cmd = Nothing
    Set conn = Nothing
End Sub

Sub GetBinaryData()
    Dim conn As Object
    Dim rs As Object
    Dim fso As Object
    Dim stream As Object
    
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set stream = CreateObject("ADODB.Stream")
    
    conn.Open "连接字符串"
    
    rs.Open "SELECT 图片字段 FROM 表名 WHERE 条件", conn
    
    If Not rs.EOF Then
        stream.Type = 1 ' adTypeBinary
        stream.Open
        stream.Write rs.Fields("图片字段").Value
        stream.SaveToFile "C:\保存路径\图片名.jpg", 2 ' adSaveCreateOverWrite
        stream.Close
    End If
    
    rs.Close
    conn.Close
End Sub

Sub TransactionExample()
    Dim conn As Object
    On Error GoTo ErrorHandler
    
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "连接字符串"
    
    ' 开始事务
    conn.BeginTrans
    
    ' 执行多个SQL操作
    conn.Execute "UPDATE 表名 SET 字段=值 WHERE 条件"
    conn.Execute "INSERT INTO 表名 (字段) VALUES (值)"
    
    ' 提交事务
    conn.CommitTrans
    conn.Close
    Exit Sub
    
ErrorHandler:
    ' 回滚事务
    If Not conn Is Nothing Then
        conn.RollbackTrans
        conn.Close
    End If
    MsgBox "错误: " & Err.Description
End Sub