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

编程问答 2022-09-02

问题描述

我们正在尝试使用 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,"/")
            .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 提到的，我可以将数据移动到数组中，对数组执行操作。但是我究竟如何将该数组放回记录集中？

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

谢谢

解决方法

您可以尝试更新查询

PrintStream
adoadoadodate-formattingexcelexcelsqlsqlvba