Create Excel Workbook with Automation

[scking]

I am trying to create an Excel workbook which would package a number of other Excel files selected from a listbox as worksheets, from within Access. I have been successful inserting the workbooks as objects from a file (OLEObjects.Add) but this creates a worksheet inside a worksheet. If I use the open command it will open the spreadsheet as a separate workbook. What options are there besides OLEObjects.Add to create a worksheet from a file?

Set oExcel = GetObject("Excel.Application&quot
If Err.Number <> 0 Then
Set oExcel = CreateObject(&quot;Excel.Application&quot
End If
oExcel.Visible = True

oExcel.Workbooks.Add
Set oWb = oExcel.ActiveWorkbook
For i = 0 To Me.lstFileList.ListCount - 1
If Me.lstFileList.Selected(i) Then
Set oWs = New Worksheet
Set oWs = oWb.Worksheets.Add()
oWb.Sheets(oWs.Name).Select
oWs.Name = Me.lstFileList.Column(0, i)
oExcel.ActiveSheet.OLEObjects.Add(Filename:=GetOutboxDir _
& Me.lstFileList.Column(0, i), _
Link:=False, DisplayAsIcon:= _
False).Select
End If
Next i ----------------------
scking@arinc.com
Life is filled with lessons.
We are responsible for the
results of the quizzes.
-----------------------

 

[oharab]

Steve,
I am assuming you have a set of xls files in a seperate directory that you are trying to collate. This code should get you somewhere near.

Dim oWBFrom as Object

Set oExcel = GetObject(&quot;Excel.Application&quot
If Err.Number <> 0 Then
Set oExcel = CreateObject(&quot;Excel.Application&quot
End If
oExcel.Visible = True

Set oWb = oExcel.Workbooks.Add
For i = 0 To Me.lstFileList.ListCount - 1
If Me.lstFileList.Selected(i) Then

set oWBFrom=Workbooks.Open Filename:=Me.lstFileList.Column(0, i)
oWBFrom.Sheets(1).Copy Before:=oWb.Sheets(1)
oWBFrom.Close

End If
Next i

HTH

Ben ----------------------------------------
Ben O'Hara
Home: bpo@SickOfSpam.RobotParade.co.uk
Work: bo104@SickOfSpam.westyorkshire.pnn.police.uk
(in case you've not worked it out get rid of Sick Of Spam to mail me!)
Web:

http://www.RobotParade.co.uk

----------------------------------------

 

[scking]

Ben,

I got it working late yesterday. Thanks for the response. This works and actually, works quite well. It opens a destination workbook and each source workbook, copying the first worksheet to the destination workbook.
------------------------------------------

Set oExcel = GetObject(&quot;Excel.Application&quot
If Err.Number <> 0 Then
Set oExcel = CreateObject(&quot;Excel.Application&quot
End If
oExcel.Visible = True

On Error GoTo HandleErr

oExcel.Workbooks.Add
Set oWbd = oExcel.ActiveWorkbook

oExcel.DisplayAlerts = False
For i = 0 To Me.lstFileList.ListCount - 1
If Me.lstFileList.Selected(i) Then

' Open the source file and change the name
' of the worksheet.
Set oWbs = oExcel.Workbooks.Open(Filename:=GetOutputDirectory _
& Me.lstFileList.Column(0, i))
Set oWss = oWbs.Worksheets(1)
oExcel.Sheets(oWss.Name).Select
strName = oWbs.Name
If InStr(1, strName, &quot;AvStruc&quot > 0 Then
strName = &quot;Indenture&quot;
ElseIf InStr(1, strName, &quot;BOM&quot > 0 Then
strName = &quot;BOM&quot;
ElseIf InStr(1, strName, &quot;Active&quot Then
strName = &quot;Active&quot;
ElseIf InStr(1, strName, &quot;OEM&quot Then
strName = &quot;OEM PN&quot;
Else
' Continue using the old name
End If
oWss.Name = strName

Set oWsd = oWbd.Worksheets.Add()
oExcel.Workbooks(oWbs.Name).Sheets(oWss.Name).Copy Before:=oExcel.Workbooks(oWbd.Name).Sheets(1)
oWbs.Close
'Set oWsd = oExcel.ActiveSheet
'oWsd.Name = strName
strListOfFiles = strListOfFiles _
& Me.lstFileList.Column(0, i) & vbCrLf
End If
Next i

oExcel.DisplayAlerts = True
oWbd.SaveAs GetPackageDir & Me.cboTONbr & &quot;_Package&quot; ----------------------
scking@arinc.com
Life is filled with lessons.
We are responsible for the
results of the quizzes.
-----------------------