• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy data from multiple passwordprotected WB's in a folder into one worksheet in another WB

BengtK

New Member
I have written a code that opens a password protected workbook in a folder, copy some values out of it and paste the values in active woorkbook. This works fine.
My problem is that I have 16 password protected files in this folder, and I need a loop that does the same thing with every file. Below you can find the code, and I think all my problemes should be properly explained with comments inside the code. Please ask if anything is unclear. In advance, thanks for any help!
Code:

Code:
  Sub Bengt()
  Dim sPath As String
  Dim vFolder As Variant
  Dim sFile As String
  Dim sDataRange As String
  Dim mydata As String
  Dim wb As Workbook
  Dim WBookOther As Workbook
  Dim myArray As Variant  '<<does the list of passwords have to be array?
 
  
  sPath = ThisWorkbook.Path & Application.PathSeparator
  sDataRange = "Budsjett_resultat'!E2"  '<<every file I want to open has data in this sheet and range
  sFile = "BENGT.xlsm"  '<< how to make sFile be every file in folder?
  
  
  ' here I want a loop that opens every woorkbook in the folder M::\SALG\2016\Budsjett\
  
  Set WBookOther = Workbooks.Open(sPath & sFile, Password:="bengt123")
  ' all passwords starts with filename + three numbers after as you can see
  ' here I want to make excel find the password out of a list of passwords in range B100:B116
  mydata = "='" & sPath & "[" & sFile & "]" & sDataRange
  'mydata = "='M:\SALG\2016\Budsjett\Bengt.xlsmBudsjett_resultat'!E2:E54" '<< change as required
  'link to worksheet
  With ThisWorkbook.Worksheets(1).Range("T2:T54")
  'in this case I want the loop to find "BENGT"(which is the filename) in cell T1, and paste the values in range T2:T54.
  'For the other files, I want the loop to find the filename (of the file it opened) in row 1,
  'and paste the values in range ?2-?54 at the collum with the same name as the filename
  .Formula = mydata
  .Value = .Value
  WBookOther.Close SaveChanges:=False
  End With
 
  End Sub

For the password array I have tried following code:

Code:
  Sub passord()
  Dim myArray As Variant
  myArray = ThisWorkbook.Worksheets(1).Range("B100:B116")
  On Error Resume Next  'turn error reporting off
  For i = LBound(myArray, 1) To UBound(myArray, 1)
  Set wb = Workbooks.Open("M:\SALG\2016\Budsjett\BENGT.xlsm", Password:=myArray(i, 1))
  If Not wb Is Nothing Then bOpen = True: Exit For
  Next i
  
  End Sub

* I have tried to implement the last sub into the first sub, but I can't figure out how to make it work.
 
Thanks for the tip, but unfortunately I can't use powerpivot in this case because we are using ecxel 2010 on our server, and I can't install powerquery add-in on this server. :-( So I have to use VBA.
 
Back
Top