Mark A Matte
markamatte at hotmail.com
Wed May 9 10:29:52 CDT 2007
Thanks Shamil,
I was just about to email you back. I added a few lines to what you first
sent and it worked like a charm.
Adding to the call:
Dim xlApp As Excel.Application
MergeWorkbooks xlApp, "MergedBooks.xls", "C:\", "test.xls", "test1.xls"
Adding to the code:
' Create new workbook
Set rxlApp = New Excel.Application
Also, to release the merged file:
rxlApp.Quit
And finally to rename the sheets:
wbk.Worksheets(i).Name = Left(evar, InStr(1, evar, ".",
vbTextCompare) - 1)
Thank you very much. This is just what I needed.
Mark A. Matte
>From: "Shamil Salakhetdinov" <shamil at users.mns.ru>
>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: Wed, 9 May 2007 19:15:49 +0400
>
>Hi Mark,
>
>Here is the code to call from MS Access, which shouldn't fail (watch line
>wraps!):
>
>Option Explicit
>
>Public Sub TestXLMerge()
>Dim strPathName As String
>Dim strReport As String
>Dim xlApp As Object 'Excel.Application
>
> strPathName = AppPath & "test01.xls"
> strReport = "rptInvSummary"
> Access.Application.DoCmd.OutputTo acOutputReport, strReport,
>acFormatXLS, strPathName
>
> strPathName = AppPath & "test02.xls"
> strReport = "rptInvNewSummary"
> Access.Application.DoCmd.OutputTo acOutputReport, strReport,
>acFormatXLS, strPathName
>
> Set xlApp = CreateObject("Excel.Application")
> MergeWorkbooks xlApp, "MergedBooks.xls", AppPath, "test01.xls",
>"test02.xls"
> xlApp.Quit
> Set xlApp = Nothing
>End Sub
>
>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 Object 'Excel.Workbook
>Dim wbkImp As Object '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
> wbk.worksheets(i).Name = getUniqueName(wbkImp, 1, wbk)
> 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
> ' Close workbook
> wbk.Close SaveChanges:=False
> Set wbk = Nothing
>
> MergeWorkbooks = True
>HandleExit:
> Exit Function
>HandleErr:
> MergeWorkbooks = False
> MsgBox "MergeWorkbooks: Err = " & Err.Number & " - " & Err.Description
> Resume HandleExit
> Resume
>End Function
>
>Private Property Get AppPath() As String
> AppPath = Access.Application.CurrentProject.Path & "\"
>End Property
>
>Private Function getUniqueName( _
> ByRef rwbkImp As Object, _
> ByVal impWbkWksIndex As Integer, _
> ByVal rwbkDst As Object) _
> As String
>On Error Resume Next
>Dim strWksName As String
>Dim wks As Object
>Dim i As Integer
> strWksName = rwbkImp.worksheets(impWbkWksIndex).Name
> Set wks = rwbkDst.worksheets(strWksName)
> If wks Is Nothing Then
> getUniqueName = strWksName
> Exit Function
> End If
> i = 1
> Do
> Set wks = rwbkDst.worksheets(strWksName & "_" & CStr(i))
> Loop Until Not wks Is Null
> getUniqueName = strWksName & "_" & CStr(i)
>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 6:37 PM
>To: accessd at databaseadvisors.com
>Subject: Re: [AccessD] Report to Excel_
>
>Thanks Shamil,
>
>The sample call failed...because variable not defined"xlApp". Do I Dim it
>as excel.application?
>
>Thanks,
>
>Mark A. Matte
>
>P.S...They are using office97.
>
>
> >From: "Shamil Salakhetdinov" <shamil at users.mns.ru>
> >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: Wed, 9 May 2007 12:24:15 +0400
> >
> >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
> > > >>
>
>_________________________________________________________________
>PC Magazines 2007 editors choice for best Web mailaward-winning Windows
>Live Hotmail.
>http://imagine-windowslive.com/hotmail/?locale=en-us&ocid=TXT_TAGHM_migratio
>n_HM_mini_pcmag_0507
>
>
>
>--
>AccessD mailing list
>AccessD at databaseadvisors.com
>http://databaseadvisors.com/mailman/listinfo/accessd
>Website: http://www.databaseadvisors.com
_________________________________________________________________
Catch suspicious messages before you open them—with Windows Live Hotmail.
http://imagine-windowslive.com/hotmail/?locale=en-us&ocid=TXT_TAGHM_migration_HM_mini_protection_0507