VBA to open multiple protected workbooks

[Crosby87]

Hi Everyone

I am after one huge favour around 300 sheets coming into me at some point next week for a Salary Review.

I need a way to be able to unlock all of the workbooks in one folder (same password), unprotect them all (save passsword) and then copy and paste the data from the columns A-Q from the "Collated List" tab in the open workbooks to a summary workbook (name to be confirmed) with a sheet name called (Sheet Name Staff Lists)

Can anyone save my life and possibly 3 days of my life?

 

[MikeDBMan]

A couple questions:
1. Why do you need to unprotect the files that come in to you? All you need to do is provide the password to open them and then you could just read the data into an array and then close the file, right?
2. The data in Columns A-Q, is it all rows? Is there a way to determine how many rows of data?
3. Along the same line as question 2, how can you paste the data from 300 sheets (columns A-Q) into ONE sheet in your summary file? I am thinking you are only going to have a few rows from each of the files that go into your summary file, is that right?

 

[Crosby87]

Hi Mike.

Thanks for the quick reply, in answer to your questions:

1: all of the files have been protected to maintain structure and data in the workbooks, certain fields have been locked so data could not be overwritten.
2: Yes the data is all rows from Row 8 onwards (under title header) or workbook. The row length vary from workbook to workbook.
3: Sorry, my poor explanations. I need to paste all of the data from in the indvidual manager workbooks into the one summary workbook so that i get a business wide workbook.

THanks in advance.

 

[MikeDBMan]

Here is some code. I still have no idea how to determine what data to copy (as evidenced in this code as well).

Public ifile
Public AFiles()
Sub ImportAll()
Dim CodeBook As String
Let CodeBook = ThisWorkbook.Name
'Assume all the files are in the same directory
Dim ThePath As String
Dim ThePassword As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Let ThePassword = "test"  'put in the "real" password here
Let ThePath = "c:\temp\"  'This is where the files are
Dir ThePath  'Change directories to the folder where the files are located
ifile = 0
ListFilesInDirectory ThePath, 0
For X = 1 To ifile
    
    If AFiles(X) Like "*.xls*" Then
        'use this one, it is a spreadsheet
         Workbooks.Open Filename:=AFiles(X), Password:=ThePassword
         'here is the section where we have to determine how to select the data to copy, copy it
         MsgBox ("How do I know what to import???")
         'after reading the data in, close the file
         ActiveWindow.Close , savechanges:=False
         Windows(CodeBook).Activate
         'now put that data into my master file
    End If
Next
Beep
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub
 
Private Sub ListFilesInDirectory(Directory As String, EraseIt As Integer)
'This is called by the list all files function above.
  Dim X As Integer, Y As Integer
  Dim StartRow As Integer
  Dim aDirs() As String, iDir As Integer, stFile As String
Dim SubName As String
Dim Goback As Integer
Let SubName = "ListInDir"
On Error GoTo handleCancelListInDir
'MsgBox (Directory)
  ' use Dir function to find files and directories in Directory
  ' look for directories and build a separate array of them
  ' note that Dir returns files as well as directories when vbDirectory
  ' specified
  
If EraseIt = 1 Then
    'Sheets("Control").Select
    'Application.GoTo Reference:="FilesToDo"
    Application.GoTo Reference:="PathToRename"
    X = ActiveCell.Row + 1
    Y = ActiveCell.Column + 1
    Cells(X, Y).Select
    
    X = ActiveCell.Row
End If
  
  
  iDir = 0
  stFile = Directory & Dir(Directory & "*.*", vbDirectory)
  Do While stFile <> Directory
    If Right(stFile, 2) = "\." Or Right(stFile, 3) = "\.." Then
      ' do nothing - GetAttr doesn't like these directories
    ElseIf GetAttr(stFile) = vbDirectory Then
      ' add to local array of directories
      iDir = iDir + 1
      ReDim Preserve aDirs(iDir)
      aDirs(iDir) = stFile
    Else
      ' add to global array of files
      ifile = ifile + 1
      ReDim Preserve AFiles(ifile)
      AFiles(ifile) = stFile
    End If
    stFile = Directory & Dir()
 Loop
  ' now, for any directories in aDirs call self recursively
  If iDir > 0 Then
    For iDir = 1 To UBound(aDirs)
      ListFilesInDirectory aDirs(iDir) & Application.PathSeparator, 0
    Next iDir
  End If
'ProgressDetails (SubName)
If EraseIt = 1 Then
    StartRow = X
        For Y = 1 To ifile
            Cells(X, 1).Value = AFiles(Y)
            X = X + 1
        Next
        Cells(StartRow, 1).Select
End If
Exit Sub

handleCancelListInDir:
If Err = 18 Then
    Let Goback = MsgBox(prompt:="You interrupted the program by hitting the Escape key.  The system will return to the point where you caused this intervention.  Thank you.  (Note, if you wish to stop the program click Cancel instead of OK)", Title:="FLIR Systems User Intervention", Buttons:=vbYesNoCancel + vbCritical)
Else
    Let Goback = MsgBox(prompt:="In Sub " & SubName & ", there is an Error (" & Err.Number & ") of " & Err.Description & ".  The system will return to the point where this error was caused.  Thank you.", Title:="FLIR User System Error", Buttons:=vbOKCancel + vbCritical)
End If
'DetailsCntr = DetailsCntr + 1
'DetailsArray(DetailsCntr, 1) = "IN " & SubName & ", User had Error " & " and chose to " & Goback
Goback = 1
If Goback = 1 Then   'Selected OK
    Resume
ElseIf Goback = 2 Then 'Selected Cancel
    Exit Sub
ElseIf Goback = 6 Then 'Selected Yes
    Resume
ElseIf Goback = 7 Then 'Selected NO
    Resume Next
End If
End Sub