不完整的时间戳使用ADODB与Excel的VBA
我想从SQL Server拉一些数据到Microsoft Excel 2007.我有连接设置，除了时间戳，似乎一切正常。 我只能得到date，而不是相应的小时，分钟或秒钟。 我可以使用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 尼克，我想我已经find了你的解决scheme:)
让我演示使用我的示例数据。
默认情况下，Excel不具有DateTime单元格格式。 这意味着它不能在一个单元格中存储date和时间。 在数据展示方面，似乎Excel试图使用最可识别的格式 – 这是date。 它仍然存储的时间，但格式单元格的date格式丢失/ 下降的时间。
看看下面的截图： 
正如你所看到的，单元格中显示的数据看起来就像一个正常的date。 但是，如果你看公式栏 – 时间存在，但没有显示。
在代码的最后，我添加了一个Debug.Print行：
Debug.print Range("B6").Value & vbCrlf & Range("B6").Value2
我得到的结果
25/06/2013 16:00:27
41450.6669791667
因此，我已经认识到，你在Excel中的单元格中看到的不是它正在引用的内容
下一步是编写一个函数来遍历单元格，并改变格式和看到的内容。
要在一个单元格中time实现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个参数：
– 活动工作表
– 起始行
– 与date的列
要调用该函数，请在代码中的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列，以显示不同之处。
注意：我跑了这两个列B和C 
您的完整解决scheme
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
如果这个答案帮助了你，请接受和/或upvote它！ :)谢谢，祝你好运