Shamil Salakhetdinov
shamil at users.mns.ru
Wed May 9 03:24:15 CDT 2007
Hello Mark,
Below is the first version of function to merge workbooks (watch line
wraps!).
Enhancements to this code might follow today/tomorrow...
Sample call:
============
MergeWorkbooks xlApp, "MergedBooks.xls", "C:\Temp", "one.xls", "two.xls"
Code:
=====
Public Function MergeWorkbooks( _
ByRef rxlApp As Object, _
ByVal vstrSummaryWbkFileName As String, _
ByVal vstrFolder As String, _
ParamArray avar() As Variant) As Boolean
' This function merges *FIRST* worksheet of every
' workbook, which filename is specified in
' avar() ParamArray and which are located in
' vstrFolder folder.
' Merged workbook is saved into the folder of the
' source workbooks vstrFolder and this merged
' workbook gets the filename vstrSummaryWbkFileName
On Error GoTo HandleErr
Dim wbk As Excel.Workbook
Dim wbkImp As Excel.Workbook
Dim impWbkFullPath As String
Dim mergeWbkFullPath As String
Dim evar As Variant
Dim i As Integer
' Check that source workbooks list is not empty
If UBound(avar) = -1 Then
Err.Raise vbObjectError + 1, "MergeWorkbooks", _
"The list of workbooks to merge is empty."
End If
' If absent add backslash to folder name
If Len(vstrFolder) > 0 Then
If Right(vstrFolder, 1) <> "\" Then _
vstrFolder = vstrFolder & "\"
End If
' Create new workbook
Set wbk = rxlApp.Workbooks.Add
' Delete all but the first worksheet in this new workbook
For i = wbk.Worksheets.Count To 2 Step -1
rxlApp.DisplayAlerts = False
wbk.Worksheets(i).Delete
rxlApp.DisplayAlerts = True
Next i
i = 1
' Merge source workbooks into summary workbook
For Each evar In avar
impWbkFullPath = vstrFolder & CStr(evar)
Set wbkImp = rxlApp.Workbooks.Open(impWbkFullPath)
wbkImp.Worksheets(1).Cells.Copy
If wbk.Worksheets.Count < i Then _
wbk.Worksheets.Add After:=wbk.Worksheets(i - 1)
wbk.Worksheets(i).Activate
wbk.Worksheets(i).Paste
wbk.Worksheets(i).Cells(1, 1).Select
rxlApp.DisplayAlerts = False
wbkImp.Close
rxlApp.DisplayAlerts = True
i = i + 1
Next evar
wbk.Worksheets(1).Activate
mergeWbkFullPath = vstrFolder & vstrSummaryWbkFileName
' Delete merged workbook if it already exists
If Len(Dir(mergeWbkFullPath, vbNormal)) Then _
Kill mergeWbkFullPath
' Save merged workbook
wbk.SaveAs mergeWbkFullPath
MergeWorkbooks = True
HandleExit:
Exit Function
HandleErr:
MergeWorkbooks = False
MsgBox "MergeWorkbooks: Err = " & Err.Number & " - " & Err.Description
Resume HandleExit
End Function
--
Shamil
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Mark A Matte
Sent: Wednesday, May 09, 2007 12:53 AM
To: accessd at databaseadvisors.com
Subject: Re: [AccessD] Report to Excel_
Thanks Michael,
I actually got the formatting like I needed. I'm just having issues getting
the worksheets into 1 workbook.
Thanks,
Mark A. Matte
>From: "Michael R Mattys" <mmattys at rochester.rr.com>
>Reply-To: Access Developers discussion and problem
>solving<accessd at databaseadvisors.com>
>To: "Access Developers discussion and problem
>solving"<accessd at databaseadvisors.com>
>Subject: Re: [AccessD] Report to Excel_
>Date: Tue, 8 May 2007 13:58:26 -0400
>
>Mark,
>
>You could put most of your formatting in an xlt, but it's going
>to take a bit of fancy automation to replicate your report.
>
>Michael R. Mattys
>MapPoint & Access Dev
>www.mattysconsulting.com
>
>----- Original Message -----
>From: "Mark A Matte" <markamatte at hotmail.com>
>To: <accessd at databaseadvisors.com>
>Sent: Tuesday, May 08, 2007 12:55 PM
>Subject: Re: [AccessD] Report to Excel_
>
>
> > Thanks Jim,
> >
> > I need to export a report because of the conditional formatting.
> > TransferSpreadsheet won't work with reports.
> >
> > Any thoughts?
> >
> > Thanks,
> >
> > Mark A. Matte
> >
> >
> >>From: "Jim Hewson" <JHewson at karta.com>
> >>Reply-To: Access Developers discussion and problem
> >>solving<accessd at databaseadvisors.com>
> >>To: "Access Developers discussion and problem
> >>solving"<accessd at databaseadvisors.com>
> >>Subject: Re: [AccessD] Report to Excel
> >>Date: Mon, 7 May 2007 16:27:24 -0500
> >>
> >>Mark,
> >>I do this frequently. In one export I end up with 15 worksheets and
> >>manipulate the date in Excel via Access.
> >>
> >>I would use TransferSpreadsheet instead of what you have.
> >>Also, put Set appExcel = New Excel.Application before the
> >>TransferSpreadsheet command.
> >>
> >>If you use something like:
> >>
> >> DoCmd.TransferSpreadsheet acExport, , strReport1, strPathName, True
> >> DoCmd.TransferSpreadsheet acExport, , strReport2, strPathName, True
> >>
> >>It will export to separate spreadsheets.
> >>
> >>HTH
> >>
> >>Jim
> >>jhewson at karta.com
> >>
> >>
> >>-----Original Message-----
> >>From: accessd-bounces at databaseadvisors.com
> >>[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Mark A Matte
> >>Sent: Monday, May 07, 2007 4:00 PM
> >>To: accessd at databaseadvisors.com
> >>Subject: [AccessD] Report to Excel
> >>
> >>Hello All,
> >>
> >>I found the code below in the archives from Jim Hale...Anyway to use
>this
> >>approach but to have 2 reports go to the same workbook...just different
> >>tabs?
> >>
> >>Thanks,
> >>
> >>Mark A. Matte
> >>
> >>*********Code From Jim****************
> >>Sub rpt_to_excel()
> >>Dim appExcel As Excel.Application, strpathname As String Dim strpathnew
> >>As String, strReport As String
> >>
> >>strpathname = "C:\test.xls"
> >>strpathnew = "C:\test2.xls"
> >>strReport = "rptInvsummary"
> >>DoCmd.OutputTo acOutputReport, strReport, acFormatXLS, strpathname
> >>
> >>Set appExcel = New Excel.Application
> >>
> >>'format your report
> >> With appExcel
> >> .Workbooks.Open strpathname, 0
> >> .Visible = True 'just to watch the sheet
> >> .Range("A1:G1").Select
> >> .Selection.Font.Bold = True
> >> .Selection.Font.Name = "Arial"
> >> .Selection.Font.Size = 12
> >> .ActiveWorkbook.SaveAs
>Filename:=strpathnew,FileFormat:=xlNormal
> >> End With
> >> appExcel.Quit
> >> Set appExcel = Nothing
> >>End Sub
> >>
> >>_________________________________________________________________
> >>Download Messenger. Join the i'm Initiative. Help make a difference
>today.
> >>http://im.live.com/messenger/im/home/?source=TAGHM_APR07
> >>
> >>
> >>--
> >>AccessD mailing list
> >>AccessD at databaseadvisors.com
> >>http://databaseadvisors.com/mailman/listinfo/accessd
> >>Website: http://www.databaseadvisors.com
> >
> > _________________________________________________________________
> > Make every IM count. Download Messenger and join the i'm Initiative now.
> > It's free. http://im.live.com/messenger/im/home/?source=TAGHM_MAY07
> >
> >
>
>
>---------------------------------------------------------------------------
-----
>
>
> > --
> > AccessD mailing list
> > AccessD at databaseadvisors.com
> > http://databaseadvisors.com/mailman/listinfo/accessd
> > Website: http://www.databaseadvisors.com
> >
>
>--
>AccessD mailing list
>AccessD at databaseadvisors.com
>http://databaseadvisors.com/mailman/listinfo/accessd
>Website: http://www.databaseadvisors.com
_________________________________________________________________
More photos, more messages, more storageget 2GB with Windows Live Hotmail.
http://imagine-windowslive.com/hotmail/?locale=en-us&ocid=TXT_TAGHM_migratio
n_HM_mini_2G_0507