Use Module to merge Excel files

[PSmit]

I am attempting to write an Access module to merge two Excel files together. I didn't find anything on this site, but something on another that I can not seem to get working. I don't get any errors, but I don't get any results, either. Any help would be appreciated...

Here's what I found (somewhat tweeked by me) that I can't get working:

***

Dim objXL As Object
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
With objXL.Application
.Visible = True

.Workbooks("C:\Documents and Settings\Desktop\Book1.xls").MergeWorkbook FileName:="C:\Documents and Settings\Desktop\Book2.xls"
.Quit
End With
Set objXL = Nothing

***

Any ideas or thoughts?

 

[Ian Mac]

Hi,

A) Why don't you just use Excel?
B) Why do you want them merged? Is it to add to your database?

Cheers,

 

[PSmit]

Well, here's the whole senario... My boss wants a report in Access dumped to Excel. But, she also wants it pretty and formatted with colors, bold text, etc, like the Access report is. The report in question is made up of four different subreports, each of which is completely different.

Using VB, I have it to where the db will dump each of the four queries behind the subreports onto the user's desktop into seperate Excel files. I also have figured out the code now that will copy a "standard macro Excel file" from the network to the user's desktop and then open each of the four dumped files, running the particular macro that goes with that file on that file (giving all the "prettiness").

I then need to combine all four of these files into one final output file, with each of the individual files on separate tabs of the final file.

So, in essense, at the click of button in the Access DB, I will have it dump the 4 files, run the macros, then combine them into a single file for the user.

Does that make sense and explain why I can't just use Excel for this and why I need them merged? Or, am I really missing a much easier way to accomplish what I am trying to do?

 

[Rabbie]

I have an application where I need to produce the results from an Access DB as Excel workbooks. It is quite simple in VBA to write the Excel files and format them exactly the way you want.

 

[PSmit]

Can I dump several queries into the same file in Excel (on different tabs)? If so, my problem will be solved. If not, I still don't have an answer as to how to combine the files into one final files after they are outputted....

 

[Rabbie]

Because you are writing the Excel file directly from Access VBA there is no problem in doing what you want. Its just a question of opening the Query/recordsource you want and using it to produce a worksheet.

 

[PSmit]

That's my point, though... I have that part working fine. I have all four queries dumping to different Excel files perfectly.

Please refer to my original post. I need help with combining these files into one file using VBA so I can have it done when my user clicks the button within Access.

If there is a way to output the queries to different worksheets within the same Excel file, please post the code as I don't know how to do it and haven't seen anything online thus far in my search to answer this question.

If not, please refer to my original posting of code and help me find what I did wrong...

Thanks~

 

[PSmit]

Found A Solution!!!!

After more searching online, I have found a solution to my problem...

Here's the code (with some comments) to help anyone else that ever finds this post...

To actually copy a spreadsheet in one file to a spreadsheet in another, do the following (this assumes that the data you want to copy in Book1 is on the first sheet when it is opened. If it's not, after you open Book1, select what sheet it needs to be focused on, as is done with Book2):

***
Dim objXL As Object
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
With objXL.Application
.Visible = True
.Workbooks.Open FileName:="C:\Documents and Settings\Desktop\Book1.xls" ' This is the file that has the spreadsheet you want to copy
.Cells.Select ' Selects all of the spreadsheet
.Selection.Copy ' Copies the selection
.Workbooks.Open FileName:="C:\Documents and Settings\Desktop\Book2.xls" ' This is the file that you want to copy the spreadsheet into
.Sheets("Sheet2").Select ' Select the sheet to place the copy on
.ActiveSheet.Paste ' Paste the selection
.Workbooks(2).Save = True ' Save the file
.Workbooks.Close ' Close and etc below
.Quit
End With
Set objXL = Nothing

***

Ok. So, what if you have 4 files to combine and need to add a worksheet? Do the following:

***
Dim objXL As Object
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
With objXL.Application
.Visible = True
.Workbooks.Open FileName:="C:\Documents and Settings\qprismi\Desktop\Book1.xls" ' File to add the worksheet to
.Sheets.Add after:=.Worksheets("Sheet3") ' Adds the worksheet plus tells it where to add it... you can also use before instead of after
.ActiveSheet.Name = "Hello" ' Give the new worksheet a different name
.Workbooks(1).Save = True ' Save the workbook
.Workbooks.Close ' Close and etc
.Quit
End With
Set objXL = Nothing

***

Just build these into a module or add them to the VB code behind a button on your form and you should be good to go!


And, just in case any of you out there are wondering where I found this, I tweaked some information that I found at the following Excel website -- seems like a good place to reference things like this:

http://www.mrexcel.com/board2/index.php

~Happy Coding!~

 

[Pat Hartman]

The TransferSpreadsheet method allows you to specify the name of an existing file. It uses the name of the query/table being exported to create the sheet name so if you execute TransferSpreadsheet 4 times with the same destination file name but different source names (query/table), you will end up with one workbook with four sheets named after each of your queries. Sheet names may NOT contain spaces or special characters so keep that in mind.

 

[Ian Mac]

I've been trying to answer this for AGES, so I've brought it home as it won't post at work.

As Pat says you can add the sheets to the same workbook.

However, I wrote this at work I'm gonna post by god!

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

If you need the pretty formatting, can you provide the Queries you are exporting.

In the mean time you might be able to unpick some code I have which does 'sort of' what you want.

This code has an Recordset Array (8 in this instance) and places it into a workbook and does all the formatting, adds a couple of new headings and sets up the Page Setup for printing and a buch of other things.

Sub Excel()
Dim xl As Excel.Application
Dim ws As Excel.Worksheet
Dim i As Integer            'count of default worksheets
Dim n As Integer            'difference between count of default
                            'worksheets & required number of worksheets
Dim j As Integer            'loop counter
Dim strSheetName            As String
Dim iCols                   As Integer
Dim iHeaderRow              As Integer

Call GetRecordsetsForOutput()

On Error Resume Next

'Test to see if Excel is already open, stops it running twice
'I've fallen foul to that a few times!!!
Set xl = GetObject(, "Excel.Application")
If Err <> 0 Then
    Err.Clear
    'Excel was closed, try to open it
    Set xl = CreateObject("Excel.Application")
    If Err <> 0 Then
        'Excel couldn't be open, likely not installed
        'Alert the user
        MsgBox "Cannot start Excel", vbExclamation
        End
    End If
End If
On Error GoTo 0

xl.Workbooks.Add
i = xl.Worksheets.Count

Const iNoWs = UBound(rst()) 'required number of worksheets 
			    'taken from no Recordsets

n = i - iNoWs
    
   Select Case n
   Case 0                   'required number of worksheets =
                            'count of default worksheets so do nowt
   
   Case Is < 0              'required number of worksheets is greater than count
                            'of default worksheets so add "n" worksheets
                            
   xl.Worksheets.Add , , -n 'coerce n into a positive integer
   
   Case Is > 0              'required number of worksheets is less than count
                            'of default worksheets so delete "n" worksheets
   For j = i To 2 Step -1
   xl.Sheets(j).Delete
   Next
   Case Else
   End Select

For i = 1 To iNoWs

iHeaderRow = rst(i - 1).Fields.Count + 66


With xl.Worksheets(i)

    For iCols = 0 To rst(i - 1).Fields.Count - 1
        .Cells(1, iCols + 1).Value = rst(i - 1).Fields(iCols).Name
    Next
    '.Activate
    xl.ActiveWindow.DisplayGridlines = False

    If i = 4 Then
    strSheetName = "Scenario 4 pre " & Format(ExpiredKids(), "dd-mm-yy")
    Else
    strSheetName = "Scenario " & i
    End If
    
    .Name = strSheetName
    
    If rst(i - 1).RecordCount = 0 Then
    .Range("B2") = "0 Rows Returned"
    .Columns("A").Hidden = True
    
    GoTo e
    End If
    
    'Debug.Print rst(i - 1).RecordCount
    rst(i - 1).MoveFirst

    .Range("A2").CopyFromRecordset rst(i - 1)
    .Range("1:1").Font.Bold = True
    .Cells.EntireColumn.AutoFit

    With .Range(Chr(iHeaderRow - 1) & "1")
        .Value = "Date"
        .ColumnWidth = 16.29
    End With
    
    With .Range(Chr(iHeaderRow) & "1")
        .Value = "User PID"
        .ColumnWidth = 16.29
    End With
    
    With .Range("A1:L" & rst(i - 1).RecordCount + 1)
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlDash
                .Weight = xlThin
                .ColorIndex = 15
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlDash
                .Weight = xlThin
                .ColorIndex = 15
            End With

            
    End With
    
'Set the page up with row 1 printing on every sheet
    With .PageSetup
        .PrintTitleRows = "$1:$1"
        .LeftMargin = 28.35
        .RightMargin = 28.35
        .TopMargin = 28.35
        .BottomMargin = 28.35
        .Orientation = xlLandscape
        .Zoom = 79
    End With
    
e:
            .Range("A1:" & Chr(iHeaderRow) & "1").Interior.ColorIndex = 15
End With

Next i
xl.Visible = True
    
Set xl = Nothing
End Sub

The code is looking a a Public Variable:

Public rst(7)                  As Recordset

in this case, 0 to 7 recordsets = 8, you will need 3 in brackets.

The code which I am using to create the recordets is:

Public rst(7)                  As Recordset

Sub GetRecordsetsForOutput()
Dim dbs                     As DAO.Database
Dim qdfUpdateDateOutput     As QueryDef
Dim i                       As Integer
Dim strSql                  As String
Dim strPar                  As String

Set dbs = DBEngine(0)(0)

For i = 1 To UBound(rst())

'Example query only, you will need to provide the queries you have
'in order to provide a full and complete answer, also given the information
'you provide this may change a lot (see below)

strSql = vbNullString
strSql = strSql & "SELECT Field1, Field2, Field3, Field4 " 
strSql = strSql & "FROM MyTable "
strSql = strSql & "WHERE Widgets = '" & strPar & "'"

'or you can name each Query MyQueryName and number 1 to 4
'eg 
'NumberOFWidgets1
'NumberOFWidgets2
'NumberOFWidgets3
'NumberOFWidgets4
'Then instead of the following Set statement comment it out
'and uncomment the line below it 

Set rst(i - 1) = dbs.OpenRecordset(strSql)
'Set rst(i - 1) = dbs.OpenRecordset(NumberOFWidgets & i)

Next i
'e:

Set dbs = Nothing

End Sub

As I have mentioned, this is JUST some code I have used for something myself, you will need to provide the quries in order to give you a proper answer.
Hopefully you can unpick something in the mean time.
Notice that I haven't used:

.Cells.Select ' Selects all of the spreadsheet
.Selection.Copy ' Copies the selection

You don't need to do this when manipulating Excel

Sheets("Sheet1").Cells.Copy

Will copy the Sheet1 without Excel having to select it, the code will run much faster like this and it will also work if the sheet is hidden.

Cheers,

 

[PSmit]

Thanks for the posts Pat and Ian. I appreciate all of the good ideas and the help (especially as it appears it took you a lot of effort to get your post online, Ian!).

This way, I at least have several options as to how to get this thing done and working!

Thanks again~

 

[Ian Mac]

No problem.

Make sure you take Pat's Access advice whenever you can

BTW, that little known forum http://www.mrexcel.com/board2/index.php you said, 'seems like a good place to reference things like this:', is about one of the biggest Excel forums out there. I am an MVP on it and Moderate, when I can. Plug plug, I don't get to do this much I'm not a real Microsoft MVP like Pat.