View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default Help Using Ron De Bruin's RDB_Merge_Data Macro

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


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"ScottMSP" wrote in message ...
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" wrote:

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




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"ScottMSP" wrote in message ...
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.