将数据从启用宏的Excel保存到SQL

Sub SaveToSQL()
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim rng As Range
    Dim cell As Range
    
    ' 连接到SQL数据库
    Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionString = "Provider=SQLOLEDB;Data Source=服务器地址;Initial Catalog=数据库名称;User ID=用户名;Password=密码;"
    conn.Open
    
    ' 设置SQL插入语句
    strSQL = "INSERT INTO 表名 (字段1, 字段2, 字段3) VALUES (?, ?, ?)"
    
    ' 获取要保存的数据范围
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:C10")
    
    ' 遍历数据范围并插入到SQL数据库
    For Each cell In rng
        Set rs = CreateObject("ADODB.Recordset")
        rs.Open strSQL, conn, 1, 3
        
        rs.AddNew
        rs.Fields("字段1").Value = cell.Offset(0, 0).Value
        rs.Fields("字段2").Value = cell.Offset(0, 1).Value
        rs.Fields("字段3").Value = cell.Offset(0, 2).Value
        rs.Update
        
        rs.Close
        Set rs = Nothing
    Next cell
    
    ' 关闭连接
    conn.Close
    Set conn = Nothing
    
    MsgBox "数据保存成功！"
End Sub