Hi,
I am using this code for excel export. I am getting error when i copying the sheet from one work book to final workbook.
" source_workbook.Worksheets.Move Before:=final_workbook.Worksheets(“Sheet1”) "
Can anyone help on this…?
Thanks in advance.
Sub expToExcel()
'Things to Add
'Add a sheet in the final Excel file depending upon the number of books in the report
'as by defalut there
‘****************************************************************************’
Dim doc As Document
Dim rep As Report
Dim HtmlFile As String
Dim Path As String
Dim ExcelFile As String
Dim excelfinal As Excel.Application
Dim excelsource As Excel.Application
Dim source_workbook As Excel.Workbook
Dim final_workbook As Excel.Workbook
Set excelfinal = New Excel.Application
Set excelsource = New Excel.Application
Set final_workbook = excelfinal.Workbooks.Add 'this is the final workbook that we are going to use
‘’
'Declare a FSO to kill the Master file
Dim fso
Set fso = CreateObject(“Scripting.FileSystemObject”)
If fso.fileexists(“c:\master.xls”) Then fso.deletefile (“c:\master.xls”)
'’
Set doc = ActiveDocument
Path = “C:”
Set excelsource = New Excel.Application
'Now loop through each report and save it as temp text file
For i = 1 To doc.Reports.Count
Set rep = doc.Reports(i)
rep.ExportAsText (“C:” & rep.Name & “.txt”)
Set source_workbook = excelsource.Workbooks.Open("c:\" & rep.Name & ".txt")
source_workbook.Worksheets.Move Before:=final_workbook.Worksheets("Sheet1")
If i = 1 Then
final_workbook.SaveAs ("c:\Master.xls")
End If
excelsource.Workbooks.Close
Kill ("c:\" & rep.Name & ".txt")
'excelsource.Quit
'Set excelsource = Nothing
Next i
final_workbook.Save
excelfinal.Quit
Set excelfinal = Nothing
On Error Resume Next
excelfinal.Quit
Set excelfinal = Nothing
excelsource.Quit
Set excelsource = Nothing
MsgBox ("Master Excel File Created")
You should really break this up into a couple of functions or at least make the code a little easier to read.
This is the code I use to achieve a similar goal to yourself, except using after instead of before:
Create the four documents in the array on your c drive to test the code. I call this function normally by passing in the main document and the merging document.
Sub MergeExcelFiles()
On Error GoTo MergeExcelFiles_err
Dim i, n, k, m, c As Integer
Dim savepath As String
Dim filename(1 To 4) As Variant
Dim result As Boolean
ReDim filenamedeletions(0) As Variant
Open savepath & "MergeExcelFiles.log" For Output As #3
Print #3, "MergeExcelFiles commenced at " & Time
result = True ' assume no errors at start
savepath = "c:\" ' set the savepath
Dim ExcelApp As Object
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = False
ExcelApp.Interactive = False
ExcelApp.DisplayAlerts = False
On Error GoTo FileNotMerged_Err
' list of text files to merge
filename(1) = "HoldingDocument.xls"
filename(2) = "FirstToBeMerged.xls"
filename(3) = "SecondToBeMerged.xls"
filename(4) = "ThirdToBeMerged.xls"
'open first document to be used for the others to merge into
With ExcelApp.Workbooks
.Open (savepath & filename(1)) ' this case fielname(1)
ReDim Preserve filenamedeletions(UBound(filenamedeletions) + 1)
filenamedeletions(UBound(filenamedeletions)) = savepath & filename(1) ' add into deletions
End With
' merge document 2 onwards into document 1
For i = 2 To 4
With ExcelApp.Workbooks
.Open (savepath & filename(i))
ReDim Preserve filenamedeletions(UBound(filenamedeletions) + 1)
filenamedeletions(UBound(filenamedeletions)) = savepath & filename(i) ' add into deletions
End With
ExcelApp.Windows(filename(i)).Activate
ExcelApp.Sheets(1).Select
ExcelApp.Workbooks(filename(i)).Sheets(1).Move _
After:=ExcelApp.Workbooks(filename(1)).Sheets(i - 1)
Next i
'rename the worksheets
ExcelApp.Sheets(1).Name = "number 1"
ExcelApp.Sheets(2).Name = "number 2"
ExcelApp.Sheets(3).Name = "number 3"
ExcelApp.Sheets(4).Name = "number 4"
'save the merged document
ExcelApp.ActiveWorkbook.SaveAs filename:=(savepath & "TheMergedDocument.xls"), FileFormat:=xlNormal
Print #3, Chr(9) & " Excel save completed at " & Time
GoTo all_err_end 'Always go to this error regardless to close any open excel docs
FileNotMerged_Err:
Print #3, Chr(9) & "File: " & filename(i) & " failed " & " " & Time
result = False ' register an error here
Resume all_err_end ' continue to next error handler all_err_end
all_err_end:
On Error GoTo 0 'reset error flag
ExcelApp.Workbooks.Close ' close all open workbooks
' delete the excel files left behind
If result = True Then
For k = 1 To UBound(filenamedeletions)
Kill filenamedeletions(k)
Next k
End If
' write result to log file
If result = True Then
Print #3, "MergeExcelFiles completed with NO errors at " & Time
Else
Print #3, "MergeExcelFiles completed with errors at " & Time
End If
MergeExcelFiles_err: ' always come here
' close and destroy open objects
ExcelApp.Quit
Set ExcelApp = Nothing
Set fso = Nothing
' write result to log file
If Err.Number <> 0 Then
Print #3, "MergeExcelFiles ended with Fatal Error: " & Err.Number & " - " & Err.Description & " " & Time
End If
Close #3 ' close log file
End Sub
(BOB member since 2005-05-13)