Link to home
Start Free TrialLog in
Avatar of duncanb7
duncanb7

asked on

how to set time format in ADO and query table

Dear Expert,

I would like to know how to set time format from  both methods of extracting data using
querytable and ADOrecord connection. For example, in the extracted database excel xls file, the
field data of time is 3:00 but it is extracted after by the two method that is shown as
1/1/1900 3:00 in the target  excel file. I just know how to convert back  or do time setting
before any query and ADO connection extract. And I don't want to use a way such as  Range("A1:A100).numberformat="hh:mm:ss" since it is not good practise.
Please review those two Sub routines for data extract from querytable and ADo connection
as follows

Please advise & BR

Duncan



Sub testQuery()


Dim sSQL As String
    Dim sConn As String
    Dim oQT As QueryTable
    Dim wsQuery As Worksheet
   
    Set wsQuery = ActiveWorkbook.Worksheets(1)
   
    sConn = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=D:\wkw\Summary\stock\Charter\stockdata\data2.xls;Extended Properties='Excel 8.0';"
   
    sSQL = "SELECT date, time, index, vol FROM [Sheet1$];"
   
    Set oQT = wsQuery.QueryTables.Add(sConn, wsQuery.Range("A1"), sSQL)
   
    With oQT
        .FieldNames = True
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 1
       
        .Refresh
    End With
 
End Sub

Sub testADO()


GetDataFromClosedWorkbook "D:\wkw\Summary\stock\Charter\stockdata\d1.xls", "A1:B21", Range("A1:B21"), False
GetDataFromClosedWorkbook "D:\wkw\Summary\stock\Charter\stockdata\d1.xls", "MyDataRange", Range("B3"), True
End Sub


Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
    TargetRange As Range, IncludeFieldNames As Boolean)
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer
    dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
        "ReadOnly=1;DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    Set TargetCell = TargetRange.Cells(1, 1)
    If IncludeFieldNames Then
        For i = 0 To rs.Fields.Count - 1
            TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
        Next i
        Set TargetCell = TargetCell.Offset(1, 0)
    End If
    TargetCell.CopyFromRecordset rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set TargetCell = Nothing
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Sub
InvalidInput:
    MsgBox "The source file or source range is invalid!", _
        vbExclamation, "Get data from closed workbook"
End Sub


ASKER CERTIFIED SOLUTION
Avatar of StellanRosengren
StellanRosengren
Flag of Sweden image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of duncanb7
duncanb7

ASKER

Both suggestion is working fine
,fast and easy

Thanks for  your reply

Duncan
Hi Duncan,
I am glad that I could help. Thanks for the points. But please, explain why the answer was graded "B". From the help page on Experts-Exchange:

What's the right grade to give?
Grading at Experts Exchange is not like school. It's more like the "10-point Must" system in professional boxing; in other words, an answer is worth an A, unless it doesn't resolve your issue. If it requires you to do a little more research, or figure out one more piece of code, then it's worth a B. If you think it's not worth a B, the custom is to offer the Experts an opportunity to earn a better grade.