Using ADO to copy form a closed WB to a new WB

[QuickDraw]

I would like to copy Sheet1 from a closed workbook to a new workbook. Based on my searches I've been able to use ADO to get some properties of the closed workbook (row and column counts) as well as create a new workbook. I'm at a loss as to how to use ADO to copy from a closed workbook to a new workbook. I would like to copy the contents of Sheet1 (Row 1 is a header). Any help would be appreciated.


Private Sub CommandButton1_Click()
' Get file to convert using directory dialog
BrowseForFile "c:\", "Excel File (*.xls);*.xls", "Select Workbook"
'No file selected
If booCancel = True Then
Exit Sub
End If
MsgBox FULL_FILENAME
' Get no. of columns
Dim lngCols As Long
lngCols = ColumnCount( _
FULL_FILENAME, "Sheet1$")
MsgBox "No. of columns: " & CStr(lngCols)
' Get no. of rows
Dim lngRows As Long
'retrieves one row less than actual (doesn't include headers) so add 1
lngRows = RowCount( _
FULL_FILENAME, "Sheet1$") + 1
MsgBox "No. of rows: " & CStr(lngRows)
'Create new workbook and copy sheet 1
Set wb = NewWorkbook(1)
End Sub

Public Function ColumnCount(ByVal FullFilename As String, _
ByVal TableName As String) As Long
Dim Con As Object
Dim rs As Object
Dim strCon As String
Const CONN_STRING As String = "" & "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<FULL_FILENAME>;" & _
"Extended Properties='Excel 8.0;HDR=YES'"
' Build connection string
strCon = CONN_STRING
strCon = Replace(strCon, "<FULL_FILENAME>", FullFilename)
' Open connection to workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.CursorLocation = 3 ' client-side
.ConnectionString = strCon
.Open
' Get column schema details
Set rs = .OpenSchema(4, _
Array(Empty, Empty, TableName, Empty))
End With
With rs
.ActiveConnection = Nothing
Con.Close
ColumnCount = .RecordCount
End With
End Function

Public Function RowCount(ByVal FullFilename As String, _
ByVal TableName As String) As Variant
Dim Con As Object
Dim rs As Object
Dim strCon As String
Dim strSql1 As String
Const CONN_STRING As String = "" & "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<FULL_FILENAME>;" & _
"Extended Properties='Excel 8.0;HDR=YES'"
Const SQL As String = "" & "SELECT COUNT(*) FROM [<TABLE_NAME>];"
' Build connection string
strCon = CONN_STRING
strCon = Replace(strCon, "<FULL_FILENAME>", FullFilename)
' Build sql
strSql1 = SQL
strSql1 = Replace(strSql1, "<TABLE_NAME>", TableName)
' Open connection to workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.CursorLocation = 3 ' client-side
.ConnectionString = strCon
.Open
Set rs = .Execute(strSql1)
End With
With rs
.ActiveConnection = Nothing
Con.Close
.MoveLast
RowCount = .Fields(0).Value
End With
End Function

Function NewWorkbook(wsCount As Integer) As Workbook
' creates a new workbook with wsCount (1 to 255) worksheets
Dim OriginalWorksheetCount As Long
Set NewWorkbook = Nothing
If wsCount < 1 Or wsCount > 255 Then Exit Function
OriginalWorksheetCount = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = wsCount
Set NewWorkbook = Workbooks.Add
ActiveWorkbook.SaveAs InputBox("File Name")
Application.SheetsInNewWorkbook = OriginalWorksheetCount
'Sheets("Sheet1").Select
'Sheets("Sheet1").Name = "Summary"
End Function


Public Sub PutRecordSetInSheet(ByVal FullFilename As String, _
ByVal TableName As String)
'????????????????????????????
End Sub

[stanl]

Since you are using Jet 4.0 and the Excel ISAM for your connection object, use SELECT INTO.... This works for me (just make sure that temp.xls does not already exist, and if it does, then make sure sheet1 does not exist.



cSQL = "SELECT * INTO [Excel 8.0;Database=C:\temp\temp.xls.[sheet1] FROM [sheet1$]"
oConnection.Execute(cSQL)



.02

Stan

[stanl]

Oh, I forgot SELECT INTO assumes your Excel sheet is a database, but it appears that is what you had in mind. If not I apologize for misreading your post.

Stan

[QuickDraw]

Thanks stanl. Got it to work just fine. :thumb