Option Explicit
Option Private Module
Dim InputFolder As String
Dim OutputFolder As String
Dim CurrentFolder As String
Dim wbDestination As Workbook
Dim fso As Object
Dim strFileName As String
Public Sub Select_Folder()
Dim sFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
If .Show = -1 Then
sFolder = .SelectedItems(1)
End If
End With
If sFolder <> "" Then
Settings.Range("StoreFolder").Value = sFolder
End If
End Sub
Public Sub Create_Report()
Set fso = CreateObject("Scripting.FileSystemObject")
InputFolder = IIf(Settings.Range("StoreFolder").Value = "", ThisWorkbook.Path, Settings.Range("StoreFolder").Value)
OutputFolder = fso.BuildPath(InputFolder, "_Output")
strFileName = ""
If Not (fso.FolderExists(fso.BuildPath(InputFolder, "HL")) And fso.FolderExists(fso.BuildPath(InputFolder, "SL"))) Then
MsgBox "Either HL or SL, or both folders don't exist!", vbOKOnly, "Warning"
GoTo endofsub
End If
If Not fso.FolderExists(OutputFolder) Then
Debug.Print OutputFolder & " doesn't exist"
fso.CreateFolder (OutputFolder)
End If
If Not Check_Folder("HL") Then GoTo endofsub
Set wbDestination = Workbooks.Add
wbDestination.Windows(1).WindowState = xlMinimized
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Call Get_Reports("HL")
If Check_Folder("SL") Then Call Get_Reports("SL")
Application.DisplayAlerts = False
wbDestination.Sheets(1).Delete
wbDestination.Close Filename:=fso.BuildPath(OutputFolder, strFileName), SaveChanges:=True
Application.DisplayAlerts = True
Set wbDestination = Nothing
endofsub:
Set fso = Nothing
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Function Check_Folder(ByVal ReportType As String) As Boolean
Dim oFile As Object
CurrentFolder = fso.BuildPath(InputFolder, ReportType)
Check_Folder = True
If fso.GetFolder(CurrentFolder).Files.Count <> 2 Then
MsgBox "The " & ReportType & " folder doesn't have 2 files.", vbOKOnly, "Warning"
Check_Folder = False
Else
For Each oFile In fso.GetFolder(CurrentFolder).Files
If strFileName = "" Then
strFileName = Split(oFile.Name, "_IFRS_")(0)
Else
If strFileName <> Split(oFile.Name, "_IFRS_")(0) Then
MsgBox "Store name anomaly detected in folder " & ReportType, vbOKOnly, "Warning"
Check_Folder = False
End If
End If
If InStr("xlsx", fso.GetExtensionName(oFile.Path)) = 0 Then
MsgBox oFile.Name & " in " & ReportType & " folder is not an Excel file", vbOKOnly, "Warning"
Check_Folder = False
End If
If InStr(oFile.Name, "_" & ReportType & "-") = 0 Then
MsgBox oFile.Name & " in " & ReportType & " folder is not an " & ReportType & " report", vbOKOnly, "Warning"
Check_Folder = False
End If
Next oFile
End If
End Function
Private Sub Get_Reports(ByVal ReportType As String)
Dim arr(1 To 4, 1 To 3) As Variant
Dim oFile As Object
Dim FileVersion As Variant
Dim InitialCounter As Integer
Dim Counter As Integer
InitialCounter = IIf(ReportType = "HL", 1, 3)
Counter = InitialCounter
For Each oFile In fso.GetFolder(CurrentFolder).Files
FileVersion = Split(oFile.Name, "-Ver")(1)
FileVersion = Val(Split(FileVersion, "_")(0))
arr(Counter, 1) = oFile.Name
arr(Counter, 2) = FileVersion
If strFileName = "" Then strFileName = Split(oFile.Name, "_IFRS_")(0)
Counter = Counter + 1
Next oFile
If arr(InitialCounter, 2) > arr(InitialCounter + 1, 2) Then
arr(InitialCounter, 3) = 1
arr(InitialCounter + 1, 3) = 0
Else
arr(InitialCounter + 1, 3) = 1
arr(InitialCounter, 3) = 0
End If
Dim wbSource As Workbook
Dim i As Integer
For i = InitialCounter To InitialCounter + 1
Set wbSource = Workbooks.Open(fso.BuildPath(CurrentFolder, arr(i, 1)))
wbSource.Windows(1).Visible = False
If arr(i, 3) = 1 Then
wbSource.ActiveSheet.Copy after:=wbDestination.Sheets(wbDestination.Sheets.Count)
wbDestination.ActiveSheet.Name = ReportType & "_Last_V"
Else
wbSource.ActiveSheet.Copy after:=wbDestination.Sheets(wbDestination.Sheets.Count)
wbDestination.ActiveSheet.Name = ReportType & "_Prev_V"
End If
wbSource.Close SaveChanges:=False
Next i
wbDestination.Sheets(ReportType & "_Last_V").Move Before:=wbDestination.Sheets(ReportType & "_Prev_V")
Set wbSource = Nothing
End Sub