[ADO Excel] How to use ADO retrieve Excel Worksheet name and some information

[ADO Excel] How to use ADO retrieve Excel Worksheet name and some information

• Simon McMahon

  Dear Johnson,

  I have used the above in my excel file by copying this into visual basic editor.

  Actually I want the all woksheets name of my file in a sheet.

  Suppose if i have one file named c:\a.xls having four different sheets. Can you please tell me how to apply this code into the file.

  I am new to this thing please advice me in full, means i have to just copy the thing which you will give me.

  Please write sub () and endsub in this code also so that i can understand in full. Because I have already tried the above but error is coming

  Sub a()

  Dim mExcel As New Excel.Application, wb As Workbook, ws As Worksheet, YrXlsFilNam As String
  YrXlsFilNam = "c:\a.xls"
  set mExcel.workbooks.open(YrXlsFilNam) (Error is coming in this line)
  Debug.Print wb.Worksheets.Count
  For Each ws In wb.Worksheets
  Debug.Print ws.Name
  Next

  End Sub
  

  Regards,

  Kamal
  

  
  
  

• Gilberto Lima

  Hello,
  
  Well, I managed to solve it by using an ADODB object
  thanks to "Desertphile" in newsgroup 'comp.programming'
  He posted the code below.
  
  Just copy the program below in a VB6 project and place the missing objects on your form and then it will show itself.
  
  Regards,
  
  Henk
  
  
  
  Option Explicit
  
  Private Sub btnExample_Click()
  Dim cn As ADODB.Connection, c As Integer, d As Integer
  Dim rsT As ADODB.Recordset
  
  MousePointer = 11
  DoEvents
  
  Set cn = New ADODB.Connection
  With cn
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  .ConnectionString = "Data Source=C:\My
  Documents\productmaster.xls;" & "Extended Properties=Excel 8.0;"
  .CursorLocation = adUseClient
  .Open
  End With
  
  Set rsT = New ADODB.Recordset
  
  rsT.CursorLocation = adUseClient
  rsT.Open "SELECT * from [Sheet1$A3:U5861]", cn, adOpenStatic
  
  c = rsT.RecordCount
  
  If c > 0 Then rsT.MoveFirst
  Open "C:\smp\pm.txt" For Output As #1
  
  For d = 1 To c
  If Not IsNull(rsT.Fields(0).Value) Then
  List2.AddItem rsT.Fields(0).Value
  Else
  List2.AddItem ""
  End If
  rsT.MoveNext
  Next
  rsT.Close
  cn.Close
  Close
  
  MousePointer = 0
  DoEvents
  End Sub
  
  Private Sub Command1_Click()
  Dim cn As ADODB.Connection, c As Integer, d As Integer
  Dim rsT As ADODB.Recordset
  
  Set cn = New ADODB.Connection
  With cn
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  '.ConnectionString = "Data Source=C:\desertphile\sundata.xls;"
  & "Extended Properties=Excel 8.0;"
  .ConnectionString = "Data Source=C:\My
  Documents\productmaster.xls;" & "Extended Properties=Excel 8.0;"
  .CursorLocation = adUseClient
  .Open
  End With
  
  Set rsT = New ADODB.Recordset
  'rsT.Open "SELECT * from [Print-This$A1:A7]", cn, adOpenStatic
  'rsT.Open "SELECT * from [Print-This$]", cn, adOpenStatic
  
  rsT.CursorLocation = adUseClient
  rsT.Open "SELECT * from [Sheet1$A3:E373]", cn, adOpenStatic
  
  c = rsT.RecordCount
  
  If c > 0 Then rsT.MoveFirst
  
  For d = 1 To c
  If Not IsNull(rsT.Fields(0).Value) Then
  List2.AddItem rsT.Fields(0).Value
  Else
  List2.AddItem ""
  End If
  rsT.MoveNext
  Next
  rsT.Close
  cn.Close
  
  End Sub
  
  Private Sub Form_Load()
  
  Dim cn As ADODB.Connection
  Dim rsT As ADODB.Recordset
  Dim intTblCnt As Integer, intTblFlds As Integer
  Dim strTbl As String
  Dim rsC As ADODB.Recordset
  Dim intColCnt As Integer, intColFlds As Integer
  Dim strCol As String
  Dim t As Integer, c As Integer, f As Integer
  
  Set cn = New ADODB.Connection
  With cn
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  '.ConnectionString = "Data Source=C:\job\rancho.xls;" &
  "Extended Properties=Excel 8.0;"
  '.ConnectionString = "Data Source=C:\desertphile\sundata.xls;"
  & "Extended Properties=Excel 8.0;"
  '.ConnectionString = "Data Source=C:\My
  Documents\productmaster.xls;" & "Extended Properties=Excel 8.0;"
  .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data
  Source=c:\test\db1.mdb;"
  .CursorLocation = adUseClient
  .Open
  End With
  
  Set rsT = cn.OpenSchema(adSchemaTables)
  intTblCnt = rsT.RecordCount
  intTblFlds = rsT.Fields.Count
  List1.AddItem "Tables: " & intTblCnt
  List1.AddItem "--------------------"
  For t = 1 To intTblCnt
  strTbl = rsT.Fields("TABLE_NAME").Value
  List1.AddItem vbTab & "Table #" & t & ": " & strTbl
  List1.AddItem vbTab & "--------------------"
  For f = 0 To intTblFlds - 1
  List1.AddItem vbTab & rsT.Fields(f).Name & _
  vbTab & rsT.Fields(f).Value
  Next
  List1.AddItem "--------------------"
  Set rsC = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty,
  strTbl, Empty))
  intColCnt = rsC.RecordCount
  intColFlds = rsC.Fields.Count
  For c = 1 To intColCnt
  strCol = rsC.Fields("COLUMN_NAME").Value
  List1.AddItem vbTab & vbTab & "Column #" & c & ": " &
  strCol
  List1.AddItem vbTab & vbTab & "--------------------"
  For f = 0 To intColFlds - 1
  List1.AddItem vbTab & vbTab & rsC.Fields(f).Name & _
  vbTab & rsC.Fields(f).Value & Str$(f)
  Next
  List1.AddItem vbTab & vbTab & "--------------------"
  rsC.MoveNext
  Next
  rsC.Close
  List1.AddItem "--------------------"
  rsT.MoveNext
  Next
  rsT.Close
  cn.Close
  End Sub
  
  

• Wahl04

  Mr Choy,

  Please have a look at my blog. I have written a post on how to retrieve the worksheet names and count using ADOX.

  
  
  

• SquadShun

  To retrieve Excel worksheet name and total count of sheets is by Excel.Application, but not by AdoDb:

  Dim mExcel as new Excel.Application, wb as Workbook, ws as worksheet, YrXlsFilNam as string
  YrXlsFilNam = "...."
  set mExcel.workbooks.open(YrXlsFilNam)
  debug.print wb.worksheets.count
  for each ws in wb.worksheets
  debug.print ws.name
  next
  

  
  
• [ADO Excel] How to use ADO retrieve Excel Worksheet name and some information