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
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
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
[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
Gurpreet Singh Sawhney
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.
John Wesley Harding
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
Allen White
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
PitbullPT
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