混合数据输入上的 VBA ADO 日期格式

Question

我们正在尝试使用 ADO 从已关闭的工作簿中读取数据、删除所有空格并将任何键入错误的日期转换为有效格式。清理完数据后，会将其上传到自定义应用中。

我们使用 ADO 是为了提高速度，因为我们发现使用 VBA 打开/操作/关闭需要太长时间，这意味着我们错过了上传目标时间（我们需要将其应用于多个工作簿）。

我们遇到的问题是将日期转换为有效格式。日期以 dd/mm/yy 或 dd.mm.yy 形式输入到工作簿中 - 我们无法控制，模板是多年前创建的，我们无法更新它并应用数据验证。

我们尝试过的想法：我们有一些想法，但没有成功，有谁知道这些建议是否可行/提出替代想法？

检查一个“。”并应用 Replace(): If InStr(rs.Fields("Date").Value, ".") > 0 Then rs.Fields("Date").Value = Replace(rs.Fields("Date").Value, ".", "/")

当列作为类型​​ 202 读入记录集时，这有效：adVarWChar，不幸的是，由于大多数日期都是有效的，记录集中的数据设置为类型 7：adDate，循环时，一旦我们得到到无效的日期格式（带点），我们得到一个调试错误：

“您无法记录更改，因为您输入的值违反了为此表或列表定义的设置（例如，值小于最小值或大于最大值）。更正错误并重试”

将整列数据类型转换为202 adVarWChar： 由于上面的代码适用于格式化为文本的条目，我们有一个想法，看看我们是否可以将整列数据直接作为文本提取，我们已经尝试了 Casting 和 Convert 但无法让它工作 - 我没有不再有我们为此尝试的示例代码。我记得尝试将 IMEX=1 添加到连接字符串，但这似乎没有任何区别。

对整列应用查找/替换查询： 我们没有检索数据并循环遍历它，而是想到了直接在列上应用查找和替换查询，类似于我们能够修剪整列的方式。同样，我们找不到任何有效的代码/查询。

创建一个空记录集并将列类型设置为字符串： 我们有一个想法是创建一个空白/空记录集并手动将日期列设置为字符串类型，然后遍历检索到的数据并将它们移动到新记录集中。我们并没有走得太远，因为我们不太确定如何创建空白 RS，然后我们还想，我们如何将这些数据写回工作表 - 因为我认为你不能写回一个封闭的工作簿。

这是我目前拥有的代码：

Sub DataTesting()

On Error GoTo ErrorHandler

'set the workbook path of the file we want to read from
Dim workbookFileName As String
workbookFileName = "C:\Users\xxx\xxx\myWorkbook.xls"

'create a connection string
Dim connectionString As String
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
    & workbookFileName _
    & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;"";" 'IMEX=1"";"

'open the connection
Dim conn As ADODB.connection
Set conn = New ADODB.connection
conn.connectionString = connectionString
conn.Open

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

'Convert all data in the date column to a valid date (e.g. replace dates with decimals 1.1.21 to 01/01/2021)

'set query to select all data from the date column
Dim query As String
query = "SELECT * FROM [DATA SHEET$B2:B100]"  'col B is the Date column

With rs
    .ActiveConnection = conn
    '.Fields.Append "Date", adVarChar, 20, adFldMayBeNull   'NOT WORKING
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Source = query
    .Open

    If Not .BOF And Not .EOF Then
        While (Not .EOF)
            If InStr(rs.Fields("Date").Value, ".") > 0 Then rs.Fields("Date").Value = Replace(rs.Fields("Date").Value, ".", "/")
            .MoveNext
        Wend
    End If
    .Close
End With

conn.Close

GoTo CleanUp

ErrorHandler:
MsgBox Err.Description 'THIS WILL BE WRITTEN TO TXT FILE

CleanUp:
'ensure the record set is equal to nothing and closed
If Not (rs Is Nothing) Then
    If (rs.State And adStateOpen) = adStateOpen Then rs.Close
    Set rs = Nothing
End If

'ensure the connection is equal to nothing and closed
If Not (conn Is Nothing) Then
    If (conn.State And adStateOpen) = adStateOpen Then conn.Close
    Set conn = Nothing
End If

End Sub

更新： 我现在可以使用以下查询读取数据：

"SELECT IIF([Date] IS NULL, NULL, CSTR([Date])) AS [Date] FROM [DATA SHEET$B2:B10]"

这只有在我设置 IMEX=1 时才有效，它是只读的。我能够遍历每个项目并打印出值/检测点的位置，但我无法修改它们！

正如@Doug Coats 所述，我可以将数据移动到数组中，对数组执行操作。但是我该如何将该数组放回记录集中呢？

我想我需要关闭第一个“只读”连接，然后将其作为“写入”连接重新打开。然后以某种方式运行更新查询 - 但是如何将现有记录集值替换为数组中的值？

谢谢

Answer 1

您可以尝试更新查询

    Const SQL = " UPDATE [DATA SHEET$] " & _
                " SET [Date] = REPLACE([Date],""."",""/"")" & _
                " WHERE INSTR([Date],""."") > 0 "

    Dim n
    conn.Execute SQL, n
    MsgBox n & " records updated"

Sub testdata()
   Dim wb, ws, i
   Set wb = Workbooks.Add
   Set ws = wb.Sheets(1)
   ws.Name = "DATA SHEET"
   ws.Cells(1, 2) = "Date"
   For i = 2 To 10
      If Rnd() > 0.5 Then
         ws.Cells(i, 2) = "27.07.21"
      Else
         ws.Cells(i, 2) = "27/07/21"
      End If
   Next
   wb.SaveAs "c:\temp\so\dates.xls"
   wb.Close
End Sub