新聞財經娛樂♬資訊 News Economy

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:wkwSummarystockCharterstockdatadata2.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:wkwSummarystockCharterstockdatad1.xls", "A1:B21", Range("A1:B21"), False
GetDataFromClosedWorkbook "D:wkwSummarystockCharterstockdatad1.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