使用 ADODB 和 VBA for Excel 的不完整时间戳

Question

我正在尝试将一些数据从 SQL Server 提取到 Microsoft Excel 2007。我已经设置了连接，除了时间戳之外，一切似乎都工作正常。我只能得到要通过的日期，而不是相应的小时、分钟或秒。我可以使用 Excel ODBC 查询工具从 SQL 数据库中提取数据，并且在那里列出了小时和分钟。我尝试了各种不同的 CAST() 选项。他们都没有解决我的问题。我正在运行 Windows XP。我不知道服务器上运行的是什么版本的 Microsoft SQL。我的代码如下所示。

 Sub Populate_Sheet(theSheet As Worksheet)

    'Declare variables'
        Dim objMyConn As ADODB.Connection
        Dim objMyCmd As ADODB.Command
        Dim objMyRecordset As ADODB.Recordset
        Set objMyConn = New ADODB.Connection
        Set objMyCmd = New ADODB.Command
        Set objMyRecordset = New ADODB.Recordset

        Dim executeThisSQLStatement As String
        'Dim target As Worksheet
        'Set target = theSheet

        executeThisSQLStatement = "SELECT CAST(DateHour_CPT AS TIMESTAMP) FROM EnergyData_v"

    'Open Connection'
        objMyConn.ConnectionString = "driver={SQLServer};Data Source=DataMart;User ID=acctname.value;Password=mypass.value;"

        objMyConn.Open

    'Set and Excecute SQL Command'
        Set objMyCmd.ActiveConnection = objMyConn
        objMyCmd.CommandText = executeThisSQLStatement
        objMyCmd.CommandType = adCmdText

    'Open Recordset'
        Set objMyRecordset.Source = objMyCmd
        objMyRecordset.Open

    'Copy Data to Excel'
        theSheet.Range("A6").CopyFromRecordset objMyRecordset

End Sub

Answer 1

尼克，我想我已经为你找到了解决方案：)
让我使用我的示例数据进行演示。
默认情况下，Excel 没有DateTime 单元格格式。这意味着它不能在一个单元格中存储日期和时间。在数据表示方面，Excel 似乎只尝试使用最容易识别的格式——日期。它仍然存储时间，但将单元格格式化为丢失/丢弃时间的日期格式。

看看下面的截图：

你可以看到单元格中显示的数据看起来就像一个正常的日期。但是，如果您查看公式栏 - 时间存在但未显示。

在您的代码末尾，我添加了 Debug.Print 行：
Debug.print Range("B6").Value & vbCrlf & Range("B6").Value2
我得到的结果
25/06/2013 16:00:27
41450.6669791667
因此，我已经确认您在 Excel 中的单元格中看到的内容并不完全是它所指的内容

---

下一步是编写一个函数来遍历单元格并更改格式和所看到的内容。
为了同时实现：date 和 time 在一个单元格中我决定将单元格格式化为 Text。

Private Sub FormatDateAndTime(ByRef sheet As Worksheet, start As Long, column As String)
    Dim i As Long, rng As Range
    For i = start To sheet.Range(column & Rows.Count).End(xlUp).Row
        Set rng = sheet.Range(column & i)
        Dim str As String
        str = Split(rng.Value, " ")(0) & " " & Split(rng.Value, " ")(1)
        rng.NumberFormat = "@"
        rng = str
        Set rng = Nothing
    Next i
End Sub

FormatDateAndTime() 函数有 3 个参数：
- 活动表
- 起始行
- 日期列
要调用该函数，请在代码中的 End Sub 之前添加这一行

  // Copy Data to Excel
        theSheet.Range("A6").CopyFromRecordset objMyRecordset

  // this is the line you want to add
    FormatDateAndTime sheet:=theSheet, start:=6, column:="A"

End Sub

注意： 我已经在我的样本中发送了其他参数来证明结果，但以上内容适用于您的情况

好的，运行代码后，您应该得到如下结果
注意： 我仅对示例中的列B 运行此代码以显示差异。 em>

注意：我为B 和C 两列都运行了这个

---

您的完整解决方案：

Sub Populate_Sheet(theSheet As Worksheet)

'Declare variables'
    Dim objMyConn As ADODB.Connection
    Dim objMyCmd As ADODB.Command
    Dim objMyRecordset As ADODB.Recordset
    Set objMyConn = New ADODB.Connection
    Set objMyCmd = New ADODB.Command
    Set objMyRecordset = New ADODB.Recordset

    Dim executeThisSQLStatement As String
    'Dim target As Worksheet
    'Set target = theSheet

    executeThisSQLStatement = "SELECT CAST(DateHour_CPT AS TIMESTAMP) FROM EnergyData_v"

'Open Connection'
    objMyConn.ConnectionString = "driver={SQLServer};Data Source=DataMart;User ID=acctname.value;Password=mypass.value;"

    objMyConn.Open

'Set and Excecute SQL Command'
    Set objMyCmd.ActiveConnection = objMyConn
    objMyCmd.CommandText = executeThisSQLStatement
    objMyCmd.CommandType = adCmdText

'Open Recordset'
    Set objMyRecordset.Source = objMyCmd
    objMyRecordset.Open

'Copy Data to Excel'
    Range("A6").CopyFromRecordset objMyRecordset

    FormatDateAndTime sheet:=theSheet, start:=6, column:="A"
End Sub

Private Sub FormatDateAndTime(ByRef sheet As Worksheet, start As Long, column As String)
    Dim i As Long, rng As Range
    For i = start To sheet.Range(column & Rows.Count).End(xlUp).Row
        Set rng = sheet.Range(column & i)
        Dim str As String
        str = Split(rng.Value, " ")(0) & " " & Split(rng.Value, " ")(1)
        rng.NumberFormat = "@"
        rng = str
        Set rng = Nothing
    Next i
End Sub

如果此答案对您有所帮助，请接受和/或投票！ :) 谢谢，祝你好运