Running A Batch

Option Explicit 

Public Sub SelectSomeFiles() 
Dim fileDialog As Office.fileDialog 
Dim varFile As Variant 
Dim sFolderPath As String 
Dim sFileName As String 
Dim objWorksheet As Worksheet 
Dim objWorkbook As Workbook 
Dim lrowno As Long 

    On Error GoTo ErrorHandler 
    Set fileDialog = Application.fileDialog(MsoFileDialogType.msoFileDialogFilePicker) 
    fileDialog.Title = "Batch Runner" 
    fileDialog.InitialFileName = "C:\temp\" 
    fileDialog.AllowMultiSelect = True 
    fileDialog.Filters.Clear 
    fileDialog.Filters.Add "Excel Workbooks", "*.xls*" 
    If fileDialog.Show = False Then 
        Exit Sub 
    End If 
    If MsgBox("You have selected " & fileDialog.SelectedItems.Count & " file(s)" & _ 
              vbCrLf & vbCrLf & "Are you sure ?", _ 
              VBA.VbMsgBoxStyle.vbYesNo + vbQuestion, _ 
              "Batch Runner") = VBA.VbMsgBoxResult.vbNo Then 
        Exit Sub 
    End If 
    Set objWorksheet = Workbooks(ThisWorkbook.Name).Sheets("Results") 
    Call RemoveAllFiltering(objWorksheet) 
    objWorksheet.Cells.ClearContents 
    objWorksheet.Cells.Font.Bold = False 
    objWorksheet.Select 
    objWorksheet.Range("A1").Select 
    objWorksheet.Range("A1:B1").Value = Array("File Name", "File Size") 
    objWorksheet.Range("A1:B1").Font.Bold = True 
    lrowno = 2 
    sFolderPath = Left$(fileDialog.SelectedItems(1), InStrRev(fileDialog.SelectedItems(1), "\")) 
    sFolderPath = sFolderPath & "__Modified-" & Format(Now(), "yyyy_mmm_dd-hh_mm") & "\" 
    Call MkDir(sFolderPath) 
    For Each varFile In fileDialog.SelectedItems 
        objWorksheet.Range("A" & lrowno).Value = varFile 
        objWorksheet.Range("B" & lrowno).Value = VBA.FileLen(varFile) / 1000 & " KB" 
        sFileName = Mid$(varFile, InStrRev(varFile, "\") + 1) 
        Application.DisplayAlerts = False 
        If WbkOpenedSuccessfully(varFile, objWorkbook) = True Then 
            Application.DisplayAlerts = True 

            ' do something or check something

            Call objWorkbook.Close(False) 
        Else 
            objWorksheet.Range("D" & lrowno).Value = "Unable to Open" 
        End If 
        lrowno = lrowno + 1 
        If (lrowno Mod 10 = 0) Then 
            Workbooks(ThisWorkbook.Name).Save 
        End If 
    Next 
    objWorksheet.Range("A1").AutoFilter 
    objWorksheet.Columns("A:E").EntireColumn.AutoFit 
    Call MsgBox("Completed", vbInformation + vbOKOnly) 
    Exit Sub 
ErrorHandler: 
    Call MsgBox(Err.Number & " - " & Err.Description) End Sub 

Private Sub RemoveAllFiltering(ByVal objWorksheet As Excel.Worksheet) 
    On Error GoTo ErrorHandler 
    objWorksheet.ShowAllData 
ErrorHandler: 
End Sub 

Private Function WbkOpenedSuccessfully( _ 
    ByVal varFile As String, _ 
    ByRef objWorkbook As Excel.Workbook) As Boolean 
    On Error GoTo ErrorHandler 
    Set objWorkbook = Workbooks.Open(Filename:=varFile, UpdateLinks:=0) 
    WbkOpenedSuccessfully = True 
    Exit Function 
ErrorHandler: 
    WbkOpenedSuccessfully = False 
End Function 

Private Function WbkSavedSuccessfully( _ 
    ByVal sFolderPath As String, _ 
    ByVal sFileName As String, _ 
    ByVal objWorkbook As Excel.Workbook) As Boolean 
    On Error GoTo ErrorHandler 
    objWorkbook.SaveAs Filename:=sFolderPath & sFileName 
    WbkSavedSuccessfully = True 
    Exit Function 
ErrorHandler: 
    WbkSavedSuccessfully = False 
End Function 

Private Function PropertyExists( _ 
    ByVal objWorkbook As Workbook, _ 
    ByVal sName As String, _ 
    ByRef docProperty As Office.DocumentProperty) As Boolean 
    On Error GoTo ErrorHandler 
    Set docProperty = objWorkbook.CustomDocumentProperties.Item(sName) 
    PropertyExists = True 
    Exit Function 
ErrorHandler: 
    PropertyExists = False 
End Function