Merge/ combine password protected data from multiple folders

Ani_Excel

New Member
Joined
Apr 7, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
I am looking for a VBA code that loops through a sharepoint folder with multiple subfolders selecting all excel workbooks that start with the name “pet_”. From all these “pet_” excel workbooks I want to pick up all content (fixed number of columns, variable number of rows) of sheet 1 (without the header) and consolidate the data into one master workbook. The excel workbooks are all password protected. The password is either “cat”, “dog” or “mouse”.

I am new to VBA and specifically trying to understand how to loop through a folder with multiple subfolders.

I have received a code but cannot make it work. The VBA stops running at "MyFile". I also don't understand why the "Filename" includes "MyPath" as "MyPath" is already included in the "MyFile". I also don't understand the last "Clean up" step. Wouldn't that empty the sheet where I collected all the data in?

Here are also two examples for the path:



Any help is appreciated


Option Explicit

Sub CombineWorkbooks()
Dim MyPath As String
Dim MyFile As String
Dim Wb As Workbook
Dim MasterWb As Workbook
Dim Passwords As Variant
Dim i As Integer
Dim ws As Worksheet

'Define the path to your SharePoint folder here
MyPath = "https://animalcollaborate.sharepoint.com/sites/Budget/Shared Documents/General/"

'Array of possible passwords
Passwords = Array("cat", "dog", "mouse")

'Create a new workbook to store the combined data
Set MasterWb = Application.Workbooks.Add

'Look for Excel files in the folder
MyFile = Dir(MyPath & "*/pet%20_*.xlsx")

'Loop through each Excel file
Do While MyFile <> ""
'Attempt to open the workbook with each password
For i = 0 To UBound(Passwords)
On Error Resume Next 'Resume on error if password is incorrect
Set Wb = Workbooks.Open(Filename:=MyPath & "\" & MyFile, Password:=Passwords(i))
On Error GoTo 0 'Reset error handling
If Not Wb Is Nothing Then Exit For 'If workbook is open, exit loop
Next i

'If workbook could be opened, copy the data
If Not Wb Is Nothing Then
'Copy data from Sheet1 to the master workbook
With Wb.Sheets(1).UsedRange
'Skip the header row
.Offset(1, 0).Resize(.Rows.Count - 1).Copy MasterWb.Sheets(1).Cells(MasterWb.Sheets(1).Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

'Close the source workbook without saving changes
Wb.Close SaveChanges:=False
Set Wb = Nothing
End If

'Get the next file name
MyFile = Dir
Loop

'Clean up
Set MasterWb = Nothing
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,215,013
Messages
6,122,690
Members
449,092
Latest member
snoom82

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top