[AccessD] Report to Excel_

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






More information about the AccessD mailing list