通过VBA实现SQL记录的插入或更新（按日期键判断）

我来帮你调整这段VBA代码，实现以日期为主键的插入/更新（Upsert）操作——如果数据库里已有该日期的记录就更新，没有就插入新记录。

核心思路 #

针对SQL Server，最简洁高效的方式是使用MERGE语句，它能在单条SQL命令里完成“判断-更新/插入”的逻辑，避免多次数据库交互。当然也可以用IF EXISTS先查询再执行对应操作，但MERGE更适合这种场景。

修改后的完整代码 #

Sub SendData(AB As String, CD As String, EF As String, GH As String, IJ As String, KL As Double, MN As Double, PQ As Double, RS As Double)
    Dim DateKey As String ' 重命名Date变量，避免和VBA内置关键字冲突
    Dim Entity As String, area As String, unit As String, name As String, surname As String
    Dim day As Double, weekly As Double, month As Double, year As Double
    Dim objConn As ADODB.Connection
    Dim strSQL As String
    
    ' 假设AB参数是作为主键的日期值，先赋值给DateKey
    DateKey = AB
    Entity = CD
    area = EF
    unit = GH
    name = IJ
    ' 这里你原代码未给surname赋值，可根据实际参数补充
    day = KL
    weekly = MN
    month = PQ
    year = RS
    
    Set objConn = New ADODB.Connection
    ' 补全你的数据库连接信息
    objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=你的服务器地址;Initial Catalog=你的数据库名;User ID=用户名;Password=密码;"

    On Error GoTo Cleanup ' 错误处理分支
    objConn.Open
    
    ' 构建MERGE语句，实现Upsert逻辑
    strSQL = "MERGE INTO 你的表名 AS Target " & _
             "USING (VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)) AS Source (DateKey, Entity, Area, Unit, Name, DayVal, WeeklyVal, MonthVal, YearVal) " & _
             "ON Target.DateKey = Source.DateKey " & _
             "WHEN MATCHED THEN " & _
             "    UPDATE SET Entity = Source.Entity, Area = Source.Area, Unit = Source.Unit, " & _
             "                Name = Source.Name, DayVal = Source.DayVal, WeeklyVal = Source.WeeklyVal, " & _
             "                MonthVal = Source.MonthVal, YearVal = Source.YearVal " & _
             "WHEN NOT MATCHED THEN " & _
             "    INSERT (DateKey, Entity, Area, Unit, Name, DayVal, WeeklyVal, MonthVal, YearVal) " & _
             "    VALUES (Source.DateKey, Source.Entity, Source.Area, Source.Unit, Source.Name, " & _
             "            Source.DayVal, Source.WeeklyVal, Source.MonthVal, Source.YearVal);"
    
    ' 使用参数化查询，避免SQL注入，同时适配数据类型
    Dim objCmd As ADODB.Command
    Set objCmd = New ADODB.Command
    objCmd.ActiveConnection = objConn
    objCmd.CommandText = strSQL
    objCmd.CommandType = adCmdText
    
    ' 添加参数，顺序要和SQL里的?一一对应
    objCmd.Parameters.Append objCmd.CreateParameter("DateKey", adVarChar, adParamInput, 10, DateKey) ' 日期格式长度根据实际调整
    objCmd.Parameters.Append objCmd.CreateParameter("Entity", adVarChar, adParamInput, 50, Entity)
    objCmd.Parameters.Append objCmd.CreateParameter("Area", adVarChar, adParamInput, 50, area)
    objCmd.Parameters.Append objCmd.CreateParameter("Unit", adVarChar, adParamInput, 50, unit)
    objCmd.Parameters.Append objCmd.CreateParameter("Name", adVarChar, adParamInput, 50, name)
    objCmd.Parameters.Append objCmd.CreateParameter("DayVal", adDouble, adParamInput, , day)
    objCmd.Parameters.Append objCmd.CreateParameter("WeeklyVal", adDouble, adParamInput, , weekly)
    objCmd.Parameters.Append objCmd.CreateParameter("MonthVal", adDouble, adParamInput, , month)
    objCmd.Parameters.Append objCmd.CreateParameter("YearVal", adDouble, adParamInput, , year)
    
    ' 执行数据同步命令
    objCmd.Execute
    
    MsgBox "数据同步完成！", vbInformation
    
Cleanup:
    ' 确保资源释放，避免连接泄漏
    If objConn.State = adStateOpen Then objConn.Close
    Set objCmd = Nothing
    Set objConn = Nothing
    If Err.Number <> 0 Then MsgBox "错误：" & Err.Description, vbCritical
End Sub

关键细节说明 #

1. 变量命名修正：把原代码里的Date改成DateKey，因为Date是VBA内置关键字，直接使用会触发编译错误。
2. 参数化查询：用ADODB.Command传递参数，而非直接拼接SQL字符串，既能避免SQL注入风险，也能更好地匹配数据库数据类型。
3. MERGE语句逻辑：
   • USING (VALUES ...)：将VBA参数作为临时数据源，和目标表做匹配。
   • ON Target.DateKey = Source.DateKey：以日期为主键判断记录是否存在。
   • WHEN MATCHED THEN UPDATE：存在匹配记录时，更新对应字段值。
   • WHEN NOT MATCHED THEN INSERT：无匹配记录时，插入新数据。
4. 错误处理：添加错误捕获分支，确保无论操作成功与否，数据库连接都会被关闭，避免资源浪费。

你需要自行调整的部分 #

• 补全ConnectionString中的服务器地址、数据库名、用户名和密码。
• 替换你的表名为实际数据库表名。
• 调整SQL语句中的字段名（如DayVal、WeeklyVal），确保和你的表字段完全一致。
• 若日期是datetime类型，需将参数类型从adVarChar改为adDBDate或adDBTimeStamp。

内容的提问来源于stack exchange，提问作者user6089076