Missing data from ADODB if the first 8 rows are empty

31 viewsadodbexcelrecordsetvba
0

After days of testing, when I tried to copy data from one workbook to another using VBA ADODB connection,

I don’t found the correct way, if it’s possible to do.

My database wb comes from one extraction from SAP, so with one excel program I open this file, and using ADODB I choose some columns and, with copyfromrecordset i put the result on one sheet of my program.

Just now I have found that if the first eight records are empty the query don’t extract records. It’s possible!??!

I test this on much columns and at all I get the same result.

please see these pictures, they will explain better than my english (sorry)

as you can see the colum 4 and 5 aven’t records
First Test

I add data on cells(8,4) and on cells(9,5)
all the record off column 4 now was extract

Second Test

In the third test I ad also value on cells(7,5)
and now in each columns I've the correct records

third Test

This is the query used on test:

Sub testQryResult()
Dim fNameAndPath As Variant
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

Set WsTo = ActiveWorkbook ' program sheet
    fNameAndPath = Application.GetOpenFilename(fileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Seleziona il file da importare")
    If fNameAndPath = False Then Exit Sub
    Workbooks.Open Filename:=fNameAndPath   'xls sheet with db from SAP

    Set WsFrom = ActiveWorkbook
    WsFrom.Activate

    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & WsFrom.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
    strsql = "SELECT [(06)-Data creazione],[(07)-Inizio carico att],[(07)-Fine carico att], [(07)-Inizio trasp att], [(07)-Data FINE Sdoganamento],[(01-A)-Data di reg] from [Sheet1$];"
    rs.Open strsql, cn, adOpenStatic, adLockReadOnly, adCmdText

    rs.MoveFirst
    dbSh.Range("A2").CopyFromRecordset rs
    Else
    rs.MoveFirst
    WsTo.Sheets("ce").Range("O3").CopyFromRecordset rs

    Set rs = Nothing
    Set cn = Nothing

End Sub