Batch process multiple templates, unique passwords

[Oli.Harwood]

Hi,

This is a fairly complex question and it might not be something that is very easy to answer.

Also if this contravenes the rules on passwords/breaking/security settings/etc please feel free to delete or move as appropriate.

The Premise:

We have a number of templates (approx. 250) which we are looking to host on a shared LAN and then ask a number of people to complete and populate.

These templates will then hold salary specific information, which we wish to protect and prevent others from viewing. Therefore ideally we would be looking for each of the templates to have a specific and unique password for users to open the file.

Problem:

The problem therefore is that once each of the templates has been completed, we want to be able to batch process them and perform some data stripping function which will prime the information in such a way so that we can load it into one of our systems.

Would anyone have any idea of what would be needed to perform this task?

I had though of some kind of document, which would hold a master list of the password for each file. Then a macro could be used which tries to go through a selected folder and picks up the first file name, then looking up the password from the master sheet, opening the file, performing the stripping function and closing the file.

Would this be workable? The difficult part for me is getting my head round how to reference the master password list and look up the correct password for each file. Each file would have a unique identifier in the format of A1234.

Alternatives:

If this is not easily implemented, does anyone have any other ideas on how we could work the security of this. Options we have come up with would be:

1. Have secured LAN access and make sure each person can only see his or her own folders/templates
2. Email the templates to each individual, therefore eliminating the shared LAN security problems.
3. Hide the salary information, which causes problems with making sure the salary info is correct.

Any help is greatly appreciated and I also appreciate that this is a big ask and perhaps something that be approached more professionally than purely hacking together some VBA/Excel macro.

There must be an easy way of doing all this but unfortunately we have neither the time nor money to implement a proprietary system.

Thanks,

Oli

 

[BrianB]

This is quite a common requirement, so I have set up a generic version that should hopefully be easily adaptable to your needs.

'==========================================================================
'- COLLECT DATA FROM A LIST OF WORKBOOKS - WORKSHEET - PASSWORD
'- Brian Baulsom July 2006
'==========================================================================
'- set up a master workbook with columns listing the workbooks to be opened
'- eg."Workbook","WorkSheet","Password"
'- with this method you can also have a "Path" column for each **
'===========================================================================
Sub DATA_TO_SUMMARY()
    Dim MasterBook As Workbook
    '- lookup sheet in MasterBook
    Dim MasterList As Worksheet
    Dim MyLookup As Range
    '- results sheet in MasterBook
    Dim ToSheet As Worksheet
    Dim ToRow As Long
    '-------------------------------------------------------------
    Dim MyBookPath As String    ' source folder
    Dim MyBook As String
    Dim MySheet As String
    Dim MyPassword As String
    '--------------------------------------------------------------
    Set MasterBook = ThisWorkbook
    Set MasterList = MasterBook.Worksheets("LookupList")
    Set MyLookup = MasterList.Range("A1:D250")
    Set ToSheet = MasterBook.Worksheets("Results")
    '--------------------------------------------------------------
    MyBookPath = "c:\test\"  ' **can add to separate lookups
    ToRow = 2
    '- go through list & process files
    For f = 2 To 250
        MyBook = MyLookup.Cells(f, 1).Value & ".xls"
        MySheet = MyLookup.Cells(f, 2).Value
        MyPassword = MyLookup.Cells(f, 3).Value
        '- show status
        Application.StatusBar = " Processing file :" & f & "." & MyBook
        '- open the workbook
        Workbooks.Open FileName:=MyBookPath & MyBook, Password:=MyPassword
        '------------------------------------------------------------
        '- perform action

        ToSheet.Cells(ToRow, 1).Value = MyBook
        ToSheet.Cells(ToRow, 2).Value = Worksheets(MySheet).Cells(1, 1).Value
        ToRow = ToRow + 1
        '------------------------------------------------------------
        '- close file
        Windows(MyBook).Close savechanges:=False
    Next
    '----------------------------------------------------------------
    '- finished
    MsgBox ("Done")
    Application.StatusBar = False
End Sub
'=== EOP ============================================================

 

[Oli.Harwood]

Hi BrianB,

Thanks for that, it looks good and I might be able to adapt it to what I want.

I notice that in your example, it reads the file from the Lookup list and then opens it and uses the password. Do you think it would be fairly easy to get it to pick up the file name and then check the list for the correct password?

Something like

fname= Dir(...
Do while fname<>""
for f = 2 to 250
if fname = MyLookup.Cells(f, 1).Value & ".xls"
Open with mypassword
else next


EDIT==============================

Ok managed to get that working ok on some test workbooks.

One thing I'm not very good on is handling any exceptions, would anyone be able to help me deal with what happens if the password in the lookup list is incorrect? I don't really want it to bring up the debug menu, would prefer to be able to just bring up a message box saying the password was incorrect and then skip to the next file in line.

 

[BrianB]

Glad to see you are getting along. Don't have a lot of spare time at present.

Hopefully this will do it :-

'** PARTIAL CODE **
'- try to open the workbook
On Error Resume Next 'next line error will not stop macro
Workbooks.Open FileName:=MyBookPath & MyBook, Password:=MyPassword
On Error GoTo 0     'later errors will show
'---------------------------------------------------------------
'- check for error
If Err.Number <> 0 Then
    ToSheet.Cells(ToRow, 1).Value = MyBook
    ToSheet.Cells(ToRow, 2).Value = "Error"
    Err.Clear
Else
    '------------------------------------------------------------
    '- perform action
    ToSheet.Cells(ToRow, 1).Value = MyBook
    ToSheet.Cells(ToRow, 2).Value = Worksheets(MySheet).Cells(1, 1).Value
    ToRow = ToRow + 1
    Windows(MyBook).Close savechanges:=False
End If