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

Question

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

我们正在使用 ADO 来提高速度，因为我们发现使用 VBA 到 open/manipulate/close 花费的时间太长，这意味着我们错过了上传目标时间（我们有多个工作簿，我们需要将其应用到).

我们遇到的问题是将日期转换为有效格式。日期以 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，循环时，一次我们得到一个无效的日期格式（带点），我们得到一个调试错误：

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

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

对整个列应用 Find/Replace 查询： 我们没有检索数据并循环遍历数据，而是直接在列上应用查找和替换查询，类似于我们能够 trim 整个列的方式。同样，我们无法找到任何有效的 code/queries。

创建一个空记录集并将列类型设置为字符串: 我们有一个想法，创建一个 blank/empty 记录集并手动将日期列设置为字符串类型，然后循环检索数据并将它们移动到新的记录集中。我们并没有在这方面走得太远，因为我们不太确定如何创建一个空白的 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 所述，我可以将数据移动到数组中，对数组执行操作。但是我究竟该如何将该数组放回记录集中呢？

我想我需要关闭第一个 'read only' 连接，然后重新打开它作为 'write' 连接。然后以某种方式运行更新查询 - 但如何用数组中的值替换现有记录集值？

谢谢

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

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

VBA ADO Date Formatting on Mixed Data Input

sql

excel

vba

ado

date-formatting