The code below shows how to create custom class to achieve what you want.
You need to create 2 files:
The content of
ICombMerge.vb
file (interface module):
Public Interface ICombMerge
Property TemplateFile() As String
Property HeaderTop() As String
Property HeaderBottom() As String
Property ReportTop() As String
Property ReportBottom() As String
Property DestFile() As String
Function GetMyFileName(Optional ByVal sTitle As String = "Select file...", Optional ByVal sInitialDir As String = "C:\") As String
Function SaveAsFileName(Optional ByVal sTitle As String = "Save As ...", Optional ByVal sInitialDir As String = "C:\") As String
Function MergeFiles() As Long
End Interface
The content of
TCombMerge.vb
file (class module):
Public Class TCombMerge
Implements ICombMerge
Dim sHT As String = String.Empty
Dim sHB As String = String.Empty
Dim sRT As String = String.Empty
Dim sRB As String = String.Empty
Dim sTF As String = String.Empty
Dim sDF As String = String.Empty
Public Sub New()
sTF = Application.StartupPath & "\Templates\MergedReport.xls"
sDF = Application.StartupPath & "\Output\" & DateTime.Today & "_MergedReport.xls"
End Sub
Public Sub New(ByVal _tf As String, ByVal _ht As String, ByVal _hb As String, ByVal _rt As String, ByVal _rb As String, ByVal _df As String)
sTF = _tf
sHT = _ht
sHB = _hb
sRT = _rt
sRB = _rb
sDF = _df
End Sub
Property TemplateFile() As String Implements ICombMerge.TemplateFile
Get
Return sTF
End Get
Set(ByVal _tf As String)
sTF = _tf
End Set
End Property
Property DestFile() As String Implements ICombMerge.DestFile
Get
Return sDF
End Get
Set(ByVal _df As String)
sDF = _df
End Set
End Property
Property HeaderTop() As String Implements ICombMerge.HeaderTop
Get
Return sHT
End Get
Set(ByVal _ht As String)
sHT = _ht
End Set
End Property
Property HeaderBottom() As String Implements ICombMerge.HeaderBottom
Get
Return sHB
End Get
Set(ByVal _hb As String)
sHB = _hb
End Set
End Property
Property ReportTop() As String Implements ICombMerge.ReportTop
Get
Return sRT
End Get
Set(ByVal _rt As String)
sRT = _rt
End Set
End Property
Property ReportBottom() As String Implements ICombMerge.ReportBottom
Get
Return sRB
End Get
Set(ByVal _rb As String)
sRB = _rb
End Set
End Property
Function GetMyFileName(Optional ByVal sTitle As String = "Select file...", Optional ByVal sInitialDir As String = "C:\") As String Implements ICombMerge.GetMyFileName
Dim dlgOpen As OpenFileDialog = Nothing, dlgRes As DialogResult = DialogResult.Cancel
Dim sFileName As String = String.Empty
Try
dlgOpen = New OpenFileDialog()
With dlgOpen
.Title = sTitle
.InitialDirectory = sInitialDir
.CheckFileExists = True
.CheckPathExists = True
.Filter = "Excel files (*.xls)|*.xls"
.FilterIndex = 0
.DefaultExt = "xls"
.AddExtension = True
.Multiselect = False
dlgRes = .ShowDialog
End With
If dlgRes = DialogResult.Cancel Then Exit Try
sFileName = dlgOpen.FileName
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error...")
Finally
dlgOpen = Nothing
End Try
Return sFileName
End Function
Function SaveAsFileName(Optional ByVal sTitle As String = "Save As ...", Optional ByVal sInitialDir As String = "C:\") As String Implements ICombMerge.SaveAsFileName
Dim dlgSave As SaveFileDialog = Nothing, dlgRes As DialogResult = DialogResult.Cancel
Dim sFileName As String = String.Empty
Try
dlgSave = New SaveFileDialog()
With dlgSave
.Title = sTitle
.InitialDirectory = sInitialDir
.CheckFileExists = False
.CheckPathExists = True
.OverwritePrompt = True
.Filter = "Excel files (*.xls)|*.xls"
.FilterIndex = 0
.DefaultExt = "xls"
.AddExtension = True
dlgRes = .ShowDialog
End With
If dlgRes = DialogResult.Cancel Then Exit Try
sFileName = dlgSave.FileName
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error...")
Finally
dlgSave = Nothing
End Try
Return sFileName
End Function
Function MergeFiles() As Long Implements ICombMerge.MergeFiles
Dim retVal As Long = 0, i As Long = 0, j As Long = 0
Dim sFiles() As String = Nothing, oExc As Object = Nothing
Dim oWbkSrc As Object = Nothing, oWbkDst As Object = Nothing
Dim oWshSrc As Object = Nothing, oWshDst As Object = Nothing
Try
If sHT = String.Empty Or sHB = String.Empty Or _
sRT = String.Empty Or sRB = String.Empty Or sDF = String.Empty Then
MsgBox("Select all files!" & vbCr & _
"Header: Top and Bottom," & vbCr & _
"Report: Top and Bottom," & vbCr & _
"Destination file!", MsgBoxStyle.Information, "Information...")
Exit Try
End If
ReDim Preserve sFiles(5)
sFiles(0) = sHT
sFiles(1) = sHB
sFiles(2) = sRT
sFiles(3) = sRB
sFiles(4) = sTF
sFiles(5) = sDF
For i = sFiles.GetLowerBound(0) To sFiles.GetUpperBound(0) - 1
For j = i + 1 To sFiles.GetUpperBound(0)
If sFiles(i).ToString = sFiles(j).ToString Then
MsgBox("'" & sFiles(i).ToString & "'" & vbCr & _
" is equal to: " & vbCr & _
"'" & sFiles(j).ToString & "'" & vbCr & vbCr & _
"Can't merge the same files!", MsgBoxStyle.Information, "Information")
Exit Try
End If
Next
Next
oExc = CreateObject("Excel.Application")
oWbkDst = oExc.Workbooks.Open(sTF)
oWbkDst.SaveAs(sDF)
oWshDst = oWbkDst.Worksheets(1)
oWbkSrc = oExc.Workbooks.Open(sHT)
oWshSrc = oWbkSrc.Worksheets(1)
For i = 1 To 12
j = i + 1
oWshSrc.Range("B" & i.ToString).Copy(oWshDst.Range("B" & j.ToString))
Next
oWbkSrc.Close(False)
oWbkSrc = oExc.Workbooks.Open(sHB)
oWshSrc = oWbkSrc.Worksheets(1)
For i = 1 To 12
j = i + 1
oWshSrc.Range("B" & i.ToString).Copy(oWshDst.Range("C" & j.ToString))
Next
oWbkSrc.Close(False)
oWbkSrc = oExc.Workbooks.Open(sRT)
oWshSrc = oWbkSrc.Worksheets(1)
i = 2
Do
j = i + 14
oWshSrc.Range("A" & i.ToString & ":I" & i.ToString).Copy(oWshDst.Range("A" & j.ToString))
oWshDst.Range("K" & j.ToString).Value = 1
i = i + 1
Loop While oWshSrc.Range("A" & i.ToString).Value <> String.Empty
oWbkSrc.Close(False)
oWbkSrc = oExc.Workbooks.Open(sRB)
oWshSrc = oWbkSrc.Worksheets(1)
i = 2
Do
j = j + 1
oWshSrc.Range("A" & i.ToString & ":I" & i.ToString).Copy(oWshDst.Range("A" & j.ToString))
oWshDst.Range("K" & j.ToString).Value = 2
i = i + 1
Loop While oWshSrc.Range("A" & i.ToString).Value <> String.Empty
oWbkSrc.Close(False)
oWshDst.Columns("A:K").EntireColumn.AutoFit()
oWbkDst.Save()
oWshDst.Range("A15:K" & j.ToString).Select()
oWshDst.Range("A15:K" & j.ToString).Sort(Key1:=oWshDst.Range("A16"), Order1:=1, Key2:=oWshDst.Range("B16"), Order2:=1, _
Header:=1, OrderCustom:=1, MatchCase:=False, Orientation:=1, DataOption1:=0, DataOption2:=0)
oWshDst.Range("A15:K" & j.ToString).Borders.LineStyle = 1
oWshDst.Range("A15:K15").Interior.ColorIndex = 6
i = 16
Do
j = i + 1
oWshDst.Range("J" & i.ToString & ":J" & j.ToString).Merge()
oWshDst.Range("J" & i.ToString & ":J" & j.ToString).Formula = "=MAX(" & oWshDst.Range("I" & i.ToString & ":I" & j.ToString).Address & ")"
oWshDst.Range("J" & i.ToString & ":J" & j.ToString).Copy()
oWshDst.Range("J" & i.ToString & ":J" & j.ToString).PasteSpecial(Paste:=-4163)
i = i + 2
Loop While oWshDst.Range("A" & i.ToString).Value <> String.Empty
oWbkDst.Save()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error...")
retVal = 1
Finally
sFiles = Nothing
oWshSrc = Nothing
oWshDst = Nothing
oWbkSrc = Nothing
oWbkDst = Nothing
If Not oExc Is Nothing Then oExc.Visible = True
oExc = Nothing
End Try
Return retVal
End Function
Protected Overrides Sub Finalize()
MyBase.Finalize()
End Sub
End Class
Now, you need to change code for your form (in my example: MainFrm):
Public Class MainFrm
Dim oCombMerge As ICombMerge = New TCombMerge()
Private Sub MainFrm_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
oCombMerge = Nothing
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
With Me
.LblHT.Text = "(select file...)"
.LblHB.Text = "(select file...)"
.LblRT.Text = "(select file...)"
.LblRB.Text = "(select file...)"
.LblDstFile.Text = oCombMerge.DestFile
.LblTF.Text = "Template: " & oCombMerge.TemplateFile
.CmdHT.Text = "Top"
.CmdHB.Text = "Bottom"
.CmdRT.Text = "Top"
.CmdRB.Text = "Bottom"
.CmdDstFile.Text = "Save in..."
.CmdMerge.Text = "Merge"
End With
End Sub
Private Sub CmdHT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdHT.Click
oCombMerge.HeaderTop = oCombMerge.GetMyFileName("Select top for header file...", Application.StartupPath)
Me.LblHT.Text = oCombMerge.HeaderTop
End Sub
Private Sub CmdHB_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdHB.Click
oCombMerge.HeaderBottom = oCombMerge.GetMyFileName("Select bottom for header file...", Application.StartupPath)
Me.LblHB.Text = oCombMerge.HeaderBottom
End Sub
Private Sub CmdRT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdRT.Click
oCombMerge.ReportTop = oCombMerge.GetMyFileName("Select top for report file...", Application.StartupPath)
Me.LblRT.Text = oCombMerge.ReportTop
End Sub
Private Sub CmdRB_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdRB.Click
oCombMerge.ReportBottom = oCombMerge.GetMyFileName("Select bottom for report file...", Application.StartupPath)
Me.LblRB.Text = oCombMerge.ReportBottom
End Sub
Private Sub CmdMerge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdMerge.Click
oCombMerge.MergeFiles()
End Sub
Private Sub CmdDstFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdDstFile.Click
oCombMerge.DestFile = oCombMerge.SaveAsFileName("Save into...", Application.StartupPath & "\Output\")
Me.LblDstFile.Text = oCombMerge.DestFile
End Sub
End Class
Here is the
old source code^. Compiled without errors. Not tested on the files.