Creating a summary of multiple files with the same formatting in a folder

I am looking to create a revision log for a group of files in a folder, the number of files always changes it could be 2, it could be 20. In each file the name of the item is in cell C12 (could be A-3, A-7, B-3, anything with a letter then a number) and then in cell C9 the revision number is located. I am looking to make a macro which creates a list of 2 columns, that says the item name and revision number.

Thank you so much for your help!

Attached is an Excel file (using Excel 2003 on a Vista 32 bit system) with Macros that may help you solve your problem. Two data files that I used for testing are also attached.

The Macros are also shown below to allow others to see the code without downloading.

Option Explicit

Private Const nDestinationRowDATUM = 10      'ONE LESS than actual start row
Private Const sOutputSheetName = "Main"


Sub ClearRevisionLogDataRows()
  'This clears all the data created by the previous call to CreateRevisionLog().

  Dim iRowStart As Long
  Dim iRowEnd As Long
  
  'Find the first and last data rows
  iRowStart = nDestinationRowDATUM + 1
  iRowEnd = ThisWorkbook.Sheets(sOutputSheetName).Rows.Count

  'Clear all the data
  ThisWorkbook.Sheets(sOutputSheetName).Rows(iRowStart & ":" & iRowEnd).ClearContents
  
End Sub

Sub CreateRevisionLog()
  'This creates a 'Revision Log' of data items in a SINGLE FOLDER
  'or CHILD FOLDER per the instructions above.  This is NOT RECURSIVE.
  'It DOES NOT get data from FOLDERS and CHILD FOLDERS at the same time.
  '
  'There is NO data VALIDITY CHECKING.

  Const nDestinationColumnITEM_NAME = "A"
  Const nDestinationColumnREVISION_NUMBER = "B"
  Const nDestinationColumnWORKBOOK_NAME = "C"
  Const nDestinationColumnSHEET_NAME = "D"
  Const nDestinationColumnCOUNT = "E"

  Dim i As Integer
  Dim iDestinationRow As Integer
  Dim iDataFoundCount As Integer
  
  Dim bFileWasClosedBeforeUse As Boolean

 
  Dim mySheetName As String
  Dim sFileSpec As String
  Dim sFoundFile As String
  Dim sItemName As String
  Dim sPath As String
  Dim sPathDataFiles As String
  Dim sPathandWorkbookName As String
  Dim sRevisionNumber As String
  Dim sSearchSpec As String
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Initialization
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  'Get the path for the file that runs the code
  sPath = ThisWorkbook.Path & "\"
  
  'Assume all the folders in the file start with 'ABC' for Testing Purposes
  sFileSpec = "ABC*.xls*"
  
  'Clear the existing data if any
  Call ClearRevisionLogDataRows
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'User Selection of a File Folder using 'FolderPicker'
  'Terminate if user selects the 'Cancel' Button
  'Creation of a 'search specification'
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  sPathDataFiles = GetFolderUsingFolderPicker(sPath, "Select a FOLDER that contain the Data files.")
  If sPathDataFiles = "" Then
    MsgBox "TERMINATING by User Request."
    Exit Sub
  End If
  
  sSearchSpec = sPathDataFiles & sFileSpec
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Write Header Data on the Output Sheet
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  iDestinationRow = nDestinationRowDATUM
  
  'Output the current date and time
  iDestinationRow = iDestinationRow + 1
  ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, "A") = _
    "Searching for files started on " & Now() & "."
  
  'Output the File Specification
  iDestinationRow = iDestinationRow + 1
  ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, "A") = _
    "Searching for files with Search Specification: '" & sFileSpec & "'."
  
  'Output the Folder being searched
  iDestinationRow = iDestinationRow + 1
  ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, "A") = _
    "Searching in Folder: '" & sPathDataFiles & "'."
  
  'Create a line with a "." ("." required during use of sub that clears data)
  iDestinationRow = iDestinationRow + 1
  ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, "A") = "'."
  
  
  
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Search for the files
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''
  sFoundFile = Dir(sSearchSpec)
  While sFoundFile <> ""
    
    'Process the file EXCEPT if it is the FILE CONTAINING this code
    'The FILE CONTAINING this code is NOT ALLOWED to be a data file
    If sFoundFile <> ThisWorkbook.Name Then
    
      'Open the Excel Data File with Macros Disabled if it isn't already open
      If IsWorkbookOpen(sFoundFile) Then
        bFileWasClosedBeforeUse = False
      Else
        bFileWasClosedBeforeUse = True
        Application.EnableEvents = False
        sPathandWorkbookName = sPathDataFiles & sFoundFile
        Workbooks.Open Filename:=sPathandWorkbookName
        Application.EnableEvents = True
      End If
    
    
      'Find all the sheets in the data file
      'Output - Item Name - Revision Number - File Name - Sheet Name
      For i = 1 To Workbooks(sFoundFile).Sheets.Count
  
        'Increment the counts
        iDataFoundCount = iDataFoundCount + 1
        iDestinationRow = iDestinationRow + 1
  
        'Get the Sheet Name
        mySheetName = Workbooks(sFoundFile).Sheets(i).Name
    
        'Get the 'Item Name' and 'Revision Number' from the input data sheet
        sItemName = Workbooks(sFoundFile).Sheets(mySheetName).Range("C12")
        sRevisionNumber = Workbooks(sFoundFile).Sheets(mySheetName).Range("C9")
    
        'Output a line of results
        ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, nDestinationColumnITEM_NAME) = sItemName
        ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, nDestinationColumnREVISION_NUMBER) = "''" & sRevisionNumber
        ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, nDestinationColumnWORKBOOK_NAME) = sFoundFile
        ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, nDestinationColumnSHEET_NAME) = mySheetName
        ThisWorkbook.Sheets(sOutputSheetName).Cells(iDestinationRow, nDestinationColumnCOUNT) = iDataFoundCount
    
      Next i
  
    
      'Close the Excel Data file only if it was opened in this procedure
      If bFileWasClosedBeforeUse Then
        Workbooks(sFoundFile).Close SaveChanges:=False
      End If
      
    End If
    
    'Find the next file in the list
    sFoundFile = Dir()
  Wend

End Sub


Function IsWorkbookOpen(sName As String) As Boolean
  'Return value TRUE if workbook is open

  Dim wb As Workbook

  On Error Resume Next

  Set wb = Workbooks(sName)
  IsWorkbookOpen = Not wb Is Nothing
  
  Set wb = Nothing
  
  On Error GoTo 0
  
End Function


Function GetFolderUsingFolderPicker(strPath As String, sUserPrompt As String) As String
  'This returns the FOLDER (AND COMPLETE PATH) selected by the User as a string with a trailing "\"
  'using 'FolderPicker' provided by Microsoft
  'This code was obtained from Richard Schollar on  MREXCEL.COM
  '
  'NOTE: It is HIGHLY RECOMMENDED to have the input strPath have a trailing "\"
   
   Dim fldr As FileDialog
   Dim sItem As String
   Dim sInitDir As String
   
   'Store initial directory (to prevent errors with later versions of Excel)
   sInitDir = CurDir
   
   'Obtain the folder name from the Folder Picker
   Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
   With fldr
    .Title = sUserPrompt
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NEXTCODE
    sItem = .SelectedItems(1)
  End With

NEXTCODE:
  
  'Reset directory before exit (to prevent errors with later versions of Excel)
  ChDrive sInitDir  'Return to the Initial Drive
  ChDir sInitDir    'Resets directory for Initial Drive
  
  'Clear the pointer
  Set fldr = Nothing
  
  'Set the return value
  GetFolderUsingFolderPicker = sItem & "\"

End Function