CODEWITHSUNDEEP
sqlvbaexcel
Solution Seeker
Solution Seeker

Reputation: 645

SQL Query against Excel Spreadsheet

I am facing a problem while firing SQL Query against Excel SpreadSheet. I have an Excel-2007 spreadsheet having around 1 lac rows with two columns. Column-1 (cid) & Column-2 (company). I would like to fetch all the rows from sheet(tab1) where company="spider". I am using below code. it's giving me results but only from first 1400 rows. If I do have company="spider" after 1400 rows it's not able to fetch it through below code. Need help for this.

Sub main()

On Error GoTo ErrHandler

Set cn = CreateObject("ADODB.Connection")
With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
      .ConnectionString = "Data Source=" & ThisWorkbook.FullName & "; Extended Properties=Excel 8.0"
    .Open
End With

Set ObjRes = cn.Execute("Select cid,company from [tab1$] where [company]= 'spider'")

result.Range("A:B").Clear
result.Range("A1").CopyFromRecordset ObjRes

cn.Close
Set cn = Nothing
Set ObjRes = Nothing

   Exit Sub
ErrHandler:
  cn.Close
  MsgBox "dataerror"

   End Sub

Please provide your valuable comments/solutions to fix this. Let me know incase you need any additional details.

Thanks.

Upvotes: 3

Views: 7337

Answers (1)

jacouh
jacouh

Reputation: 8769

This worked for me on Excel 2007:

Sub sofMain20021767()

  Dim cn, ObjRes
  Dim result

  On Error GoTo ErrHandler

  Set cn = CreateObject("ADODB.Connection")
  With cn
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0" _
      & "; Data Source=" & ThisWorkbook.FullName _
      & "; Extended Properties=""Excel 12.0 Macro;HDR=YES"""
    .Open
  End With

'
  Set ObjRes = cn.Execute("SELECT cid,company FROM [tab1$] WHERE [company]= 'spider'")
'

' result.Range("A:B").Clear
' result.Range("A1").CopyFromRecordset ObjRes

  Range("D:E").Clear
  Range("D1").CopyFromRecordset ObjRes
  '
  cn.Close
  Set cn = Nothing
  Set ObjRes = Nothing

  Exit Sub
ErrHandler:
  MsgBox Err.Description
  Set cn = Nothing

End Sub

!!!Be careful, results are copied to Range("D:E"), erasing the old data of those 2 columns.

enter image description here

enter image description here

As shown, "spider" is found on record 2 and record 2838, ie > row 1400.

Extended Properties="Excel 12.0 Macro;HDR=YES" defines an Excel Document with Macro, ie a MyDoc.xlsm file, HDR=Yes indicates that the first row is the header, ie, column names. For other format of Excel documents, please see reference.

Or you can traverse the recordset:

  '
  '...
  '
  Range("D:E").Clear
  '
  'Range("D1").CopyFromRecordset ObjRes
  '

  '
  ' now we traverse the recordset:
  '
  Dim i
  i = 1
  '
  Do While (Not ObjRes.EOF)
    Range("D" & i).Value = ObjRes(0).Value
    Range("E" & i).Value = ObjRes(1).Value
    i = i + 1
    ObjRes.MoveNext
  Loop
  '
  '...
  '

Upvotes: 6

Related Questions