Trying to Merge Data from All Excel Files into 1 MasterFile

[EDN Admin]

I’m trying to modify the VBA code from this link (I know it works fine):<br/>
http://www.rondebruin.nl/copy3.htm<br/>
<br/>
Here’s my attempt:<br/>
Imports Excel = Microsoft.Office.Interop.Excel<br/>
Imports Microsoft.Office.Interop.Excel<br/>
<br/>
Public Class Form1<br/>
<br/>
<br/>
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click<br/>
Basic_Example_1()<br/>
End Sub<br/>
<br/>
Sub Basic_Example_1()<br/>
<br/>
~~> Define your Excel Objects<br/>
Dim xlApp As New Excel.Application<br/>
Dim xlWorkBook As Excel.Workbook<br/>
Dim xlWorkSheet As Excel.Worksheet<br/>
Dim xlSourceRange As Excel.Range<br/>
Dim xlDestRange As Excel.Range<br/>
Dim rng As Excel.Range<br/>
<br/>
Dim MyPath As String<br/>
Dim FilesInPath As String<br/>
Dim MyFiles() As String<br/>
Dim SourceRcount As Long<br/>
Dim Fnum As Long<br/>
Dim mybook As Workbook<br/>
Dim BaseWks As Worksheet<br/>
Dim sourceRange As Range<br/>
Dim destrange As Range<br/>
Dim rnum As Long<br/>
Dim CalcMode As Long<br/>
<br/>
Fill in the pathfolder where the files are<br/>
MyPath = "C:UsersExcelDesktopRyan_Folder"<br/>
<br/>
<br/>
If there are no Excel files in the folder exit the sub<br/>
FilesInPath = Dir(MyPath & "*.xl*")<br/>
If FilesInPath = "" Then<br/>
MsgBox("No files found")<br/>
Exit Sub<br/>
End If<br/>
<br/>
Fill the array(myFiles)with the list of Excel files in the folder<br/>
Fnum = 0<br/>
Do While FilesInPath <> ""<br/>
Fnum = Fnum + 1<br/>
ReDim Preserve MyFiles(0 To Fnum)<br/>
MyFiles(Fnum) = FilesInPath<br/>
FilesInPath = Dir()<br/>
Loop<br/>
<br/>
<br/>
Add a new workbook with one sheet<br/>
~~> Add a New Workbook<br/>
xlWorkBook = xlApp.Workbooks.Add<br/>
<br/>
~~> Display Excel<br/>
xlApp.Visible = True<br/>
<br/>
~~> Set the relebant sheet that we want to work with<br/>
xlWorkSheet = xlWorkBook.Sheets("Sheet1")<br/>
<br/>
BaseWks = xlWorkSheet<br/>
BaseWks = xlWorkBook.Add(xlWorkSheet).Worksheets(1)<br/>
rnum = 1<br/>
<br/>
Loop through all files in the array(myFiles)<br/>
If Fnum > 0 Then<br/>
For Fnum = LBound(MyFiles) To UBound(MyFiles)<br/>
mybook = Nothing<br/>
On Error Resume Next<br/>
mybook = xlWorkBook.Open(MyPath & MyFiles(Fnum))<br/>
On Error GoTo 0<br/>
<br/>
If Not mybook Is Nothing Then<br/>
<br/>
On Error Resume Next<br/>
<br/>
With mybook.Worksheets(1)<br/>
sourceRange = .Range("A1:C1")<br/>
End With<br/>
<br/>
If Err.Number > 0 Then<br/>
Err.Clear()<br/>
sourceRange = Nothing<br/>
Else<br/>
if SourceRange use all columns then skip this file<br/>
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then<br/>
sourceRange = Nothing<br/>
End If<br/>
End If<br/>
On Error GoTo 0<br/>
<br/>
If Not sourceRange Is Nothing Then<br/>
<br/>
SourceRcount = sourceRange.Rows.Count<br/>
<br/>
If rnum + SourceRcount >= BaseWks.Rows.Count Then<br/>
MsgBox("Sorry there are not enough rows in the sheet")<br/>
BaseWks.Columns.AutoFit()<br/>
mybook.Close(SaveChanges:=False)<br/>
GoTo ExitTheSub<br/>
Else<br/>
<br/>
Copy the file name in column A<br/>
With sourceRange<br/>
BaseWks.Cells(rnum, "A"). _<br/>
Resize(.Rows.Count).Value
= MyFiles(Fnum)<br/>
End With<br/>
<br/>
Set the destrange<br/>
destrange = BaseWks.Range("B" & rnum)<br/>
<br/>
we copy the values from the sourceRange to the destrange<br/>
With sourceRange<br/>
destrange = destrange. _<br/>

Resize(.Rows.Count, .Columns.Count)<br/>
End With<br/>
destrange.Value = sourceRange.Value<br/>
<br/>
rnum = rnum + SourceRcount<br/>
End If<br/>
End If<br/>
mybook.Close(SaveChanges:=False)<br/>
End If<br/>
<br/>
Next Fnum<br/>
BaseWks.Columns.AutoFit()<br/>
End If<br/>
<br/>
ExitTheSub:<br/>
Restore ScreenUpdating, Calculation and EnableEvents<br/>
With xlApp<br/>
.ScreenUpdating = True<br/>
.EnableEvents = True<br/>
.Calculation = CalcMode<br/>
End With<br/>
End Sub<br/>
<br/>
Function RDB_Last(choice As Integer, rng As Range)<br/>
Ron de Bruin, 5 May 2008<br/>
1 = last row<br/>
2 = last column<br/>
3 = last cell<br/>
Dim lrw As Long<br/>
Dim lcol As Integer<br/>
<br/>
Select Case choice<br/>
<br/>
Case 1<br/>
On Error Resume Next<br/>
RDB_Last = rng.Find(What:="*", _<br/>
After:=rng.Cells(1), _<br/>
LookAt:=rng.xlPart, _<br/>
LookIn:=rng.xlFormulas, _<br/>
SearchOrder:=rng.xlByRows, _<br/>
SearchDirection:=rng.xlPrevious, _<br/>
MatchCase:=False).Row<br/>
On Error GoTo 0<br/>
<br/>
Case 2<br/>
On Error Resume Next<br/>
RDB_Last = rng.Find(What:="*", _<br/>
After:=rng.Cells(1), _<br/>
LookAt:=rng.xlPart, _<br/>
LookIn:=rng.xlFormulas, _<br/>
SearchOrder:=rng.xlByColumns, _<br/>
SearchDirection:=rng.xlPrevious, _<br/>
MatchCase:=False).Column<br/>
On Error GoTo 0<br/>
<br/>
Case 3<br/>
On Error Resume Next<br/>
lrw = rng.Find(What:="*", _<br/>
After:=rng.Cells(1), _<br/>
LookAt:=rng.xlPart, _<br/>
LookIn:=rng.xlFormulas, _<br/>
SearchOrder:=rng.xlByRows, _<br/>
SearchDirection:=rng.xlPrevious, _<br/>
MatchCase:=False).Row<br/>
On Error GoTo 0<br/>
<br/>
On Error Resume Next<br/>
lcol = rng.Find(What:="*", _<br/>
After:=rng.Cells(1), _<br/>
LookAt:=rng.xlPart, _<br/>
LookIn:=rng.xlFormulas, _<br/>
SearchOrder:=rng.xlByColumns, _<br/>
SearchDirection:=rng.xlPrevious, _<br/>
MatchCase:=False).Column<br/>
On Error GoTo 0<br/>
<br/>
On Error Resume Next<br/>
RDB_Last = rng.Parent.cells(lrw, lcol).Address(False, False)<br/>
If Err.Number > 0 Then<br/>
RDB_Last = rng.cells(1).Address(False, False)<br/>
Err.Clear()<br/>
End If<br/>
On Error GoTo 0<br/>
<br/>
End Select<br/>
End Function<br/>
<br/>
End Class<br/>
<br/>
<br/>
I’m not getting any compile errors or run-time errors, which is good. However, it’s not doing anything at all, which is bad. Any ideas on what I’m doing wrong here?<br/>


<
Ryan Shuell
<br/>


View the full article