VBA导入Excel短日期至SharePoint日期时间字段类型不匹配求助

问题场景 #

使用VBA将Excel表格中含=TODAY()自动填充的短日期字段，导入至SharePoint无需时间部分的日期时间字段时，出现**「Date type mismatch in criteria expression」**错误。移除日期相关行后代码可正常运行，即使按照微软建议将日期格式化为ISO 8601格式（yyyy-mm-ddThh:nn:ss）仍未解决，错误出现在行：

"'" & .Cells(1, requestDate).Value & "', " & _

错误原因分析 #

1. 重复定义子程序：代码中重复声明了Sub ImportToSP()，导致语法异常
2. 单元格引用错误：requestDate是格式化后的字符串变量，不是列索引，.Cells(1, requestDate)属于无效引用
3. 字段顺序不匹配：INSERT语句的字段顺序与VALUES里的参数顺序完全错位，导致日期值被插入到文本字段，文本值被插入到日期字段，触发类型不匹配
4. 日期格式包裹错误：SharePoint OLEDB连接要求日期值用#包裹，而非单引号

修正步骤 #

1. 删除重复的Sub ImportToSP()定义
2. 严格对齐INSERT字段与VALUES参数的顺序
3. 用#包裹格式化后的日期字符串（因SharePoint字段无需时间，可简化为yyyy-mm-dd格式）
4. 替换无效的单元格引用，直接使用格式化后的日期变量
5. 优化空白行删除逻辑，使用ListObject的原生方法更可靠

修正后的完整代码 #

Option Explicit

' SharePoint Connection
Public Const vURL As String = "https://mysharepoint.com/site/"
' obtain list from Settings URL List=1use-list-4id4-for9-b1sharepoint8list
Public Const vGUID As String = "{1use-list-4id4-for9-b1sharepoint8list}"   '<-- SPList
Public vConn As ADODB.Connection ' Needs ActiveX Data Objects 2.8
Public vConnString As String ' Needs ActiveX Data Objects 2.8
Public vRS As ADODB.Recordset ' Needs ActiveX Data Objects 2.8
Public vSQL As String
Public vCmd As ADODB.Command

Public vWB As Workbook
Public vWS As Worksheet
Public tbl As ListObject
Public i As Integer
Public requestDate As String
Public lastrow As Double

Sub ImportToSP()
    Set vWB = ActiveWorkbook
    Set vWS = vWB.Sheets("RenewalForm")
    Set tbl = vWS.ListObjects("Renewal")
    
    ' Delete blank rows in table (优化为ListObject原生方法)
    On Error Resume Next
    tbl.DataBodyRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    ' Open Connection
    vConnString = "Provider=Microsoft.Ace.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;DATABASE=" & vURL & ";LIST=" & vGUID & ";"
    
    ' Create and open the connection
    Set vConn = New ADODB.Connection
    vConn.ConnectionString = vConnString
    vConn.Open
    
    ' Loop through each row in the table, skipping the header row
    For i = 1 To tbl.ListRows.Count
        ' Get the values for each column
        With tbl.ListRows(i).Range
            ' Format the date field to match SharePoint's expected format (无需时间则简化为yyyy-mm-dd)
            requestDate = Format(.Cells(1, tbl.ListColumns("ReqDATE").Index).Value, "yyyy-mm-dd")

            vSQL = "INSERT INTO [RegistrationIMPORT] (" & _
                    "[Request Type], " & _
                    "[Group], " & _
                    "[Requester], " & _
                    "[ReqDATE], " & _
                    "[Unit], " & _
                    "[Full VIN], " & _
                    "[State], " & _
                    "[Plate Number], " & _
                    "[Vehicle needs sticker], " & _
                    "[Vehicle needs plate], " & _
                    "[Comments]) " & _
                    "VALUES (" & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("RequestType").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Group").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Requester").Index).Value, "'", "''") & "', " & _
                    "#" & requestDate & "#, " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Unit").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Full VIN").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("State").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Plate Number").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Vehicle needs sticker").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Vehicle needs plate").Index).Value, "'", "''") & "', " & _
                    "'" & Replace(.Cells(1, tbl.ListColumns("Comments").Index).Value, "'", "''") & "')"

            ' Execute the SQL command
            On Error GoTo ErrorHandler
            vConn.Execute vSQL
        End With
    Next i

    ' Close and clean up the connection
    If vConn.State = adStateOpen Then
        MsgBox "Thank you for submitting the Registration Request!  Duplicate MSO turnaround time of 7-10 business days; except for Nissan requests, please allow 4-6 weeks to complete."
        vConn.Close
        ' Clear range if add happened
        tbl.DataBodyRange.ClearContents
        ' Save the active workbook
        'vWB.Save
    End If
    Set vConn = Nothing

    Exit Sub

ErrorHandler:
    MsgBox "Request was not submitted.  Please make sure all fields have data and resubmit." & vbCrLf & Err.Description
    Debug.Print Err.Number, Err.Description
    If vConn.State = adStateOpen Then vConn.Close
    Set vConn = Nothing
End Sub

额外优化说明 #

• 添加了Replace(..., "'", "''")处理文本中的单引号，避免SQL语法错误
• 空白行删除改用SpecialCells方法，更适配ListObject结构
• 日期格式简化为yyyy-mm-dd，符合SharePoint无需时间的字段要求

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