Help Using Ron De Bruin's RDB_Merge_Data Macro

[ScottMSP]

Hello,

I am hoping someone has run into a similar situation I am having.

I am using Ron's macro that merge's seperate worksheets into one file. I
was able to tweak the macro to satisfy my needs with one exception.

Each workbook is password protected with a unique password for each. What I
need to be able to do is when the RDB_Merge macro opens each workbook, I need
the unique password to be used so that the workbook opens, then I need the
macro to finish.

Thanks in advance.

 

[Ron de Bruin]

Hi ScottMSP

You must create a list with file names and passwords and loop through that list.
Or is the password the same for all files ?

In the Workbooks.Open code you can add your password then
Bed time here now but if you give me the details I will help you tomorrow after work

 

[ScottMSP]

Ron,

Thanks for your quick response.

The password is not the same. It is different for each workbook.

I already have a macro written that will open each workbook using this line
for each workbook
Workbooks.Open Filename:="C:TestData1.xls", Password:="test1"
Workbooks.Open Filename:="C:TestData2.xls", Password:="test2"
and so on

Essentially I have the file path hard coded with the password. I prefer
your method of opening the workbooks, but not sure how to incorporate each
individual password into the open workbook command when the macro cycles
through.

Just so you know, I am a novice writing macros.

If you need more information, let me know.

Thanks in advance.

 

[Ron de Bruin]

Hi Scott

I changed the example from this page
http://www.rondebruin.nl/copy3.htm

In a sheet named "Sheet1" in your workbook make a list with the file names in column A ( I use A1:A100 in the example)
Like this
C:\Users\Ron\test\test1.xlsm
C:\Users\Ron\test\test2.xlsm

Then in column B next to the file path/name the password

Sub Basic_Example_1()
Dim SourceRcount As Long, Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
Dim cell As Range

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1

'Loop through all files on Sheet1 in A1:A100
For Each cell In ThisWorkbook.Sheets("Sheet1"). _
Range("A1:A100").SpecialCells(xlCellTypeConstants)

If Dir(cell.Value) <> "" Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(cell.Value, _
Password:=cell.Offset(0, 1).Value, WriteResPassword:=cell.Offset(0, 1).Value)

On Error GoTo 0

If Not mybook Is Nothing Then

On Error Resume Next

With mybook.Worksheets(1)
Set sourceRange = .Range("A1:C1")
End With

If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
'if SourceRange use all columns then skip this file
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0

If Not sourceRange Is Nothing Then

SourceRcount = sourceRange.Rows.Count

If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "Sorry there are not enough rows in the sheet"
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else

'Copy the file name in column A
With sourceRange
BaseWks.Cells(rnum, "A"). _
Resize(.Rows.Count).Value = cell.Value
End With

'Set the destrange
Set destrange = BaseWks.Range("B" & rnum)

'we copy the values from the sourceRange to the destrange
With sourceRange
Set destrange = BaseWks.Cells(rnum, "B"). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value

rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If
End If
Next cell
BaseWks.Columns.AutoFit

ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub

 

[ScottMSP]

Ron,

Thanks for replying to my post.

I ran into two issues:

Issue 1
I was able to get the macro to run as you instructed, however it only is
copying the first line of each worksheet. I presume that is related to the
reference of Set sourceRange= .Range("A1:C1")

When I attempted to modify the range to "A:C", it gave error message "Sorry
there are not enough rows in the sheet".

Issue 2
The copy3 example appears to only copy from the same folder and does not
include sub-folders. For that, your website recommended using the FSO macro,
which I did originally and was able to get to work, except for being able to
open password protected files. The files that I will need to open and copy
are in sub-folders. I pasted below the modifications that I made (i.e.,
subfolders=True, PasteasValues=false, SourceRng="A:AG", and so on). Is it
possible to incorporate the password solution that you offered into the RDB
Merge Data Macro?

Thanks again for all your help.

Sub RDB_Merge_Data()
Get_File_Names _
MyPath:="Q:\testpathway", _
Subfolders:=True, _
ExtStr:="*.xls"

If fnum = 0 Then Exit Sub

Get_Data _
FileNameInA:=True, _
PasteAsValues:=False, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A:AG", _
StartCell:=""

 

[Ron de Bruin]

Hi Scott

I was able to get the macro to run as you instructed, however it only is
copying the first line of each worksheet. I presume that is related to the
reference of Set sourceRange= .Range("A1:C1")

Correct
See the examples above the first macro on this page
http://www.rondebruin.nl/copy3.htm

If you have a different password for every file you must make a list on a
worksheet with the path/file name and the password from each file like in the example i posted

No need to use the FSO example then

 

[ScottMSP]

Hi Ron,

Thank you so much for your help. I was able to make the modifications and
get the macro to run and accomplish what I was hoping for.

Thanks again.

-Scott

 

[Ron de Bruin]

You are welcome