Thanks Ron for your quick response. I will try to use your code and have a
look at using code first. Hope that I can succeed.

Anyway, the problem now using windows password can not work as your first
example that already works for me. These are my codes base on your suggestion

Sub Rectangle2_Click()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String

ShName = "SUMMARY" '<---- Change
Set Rng =
Range("C7,C8,E7,D114,H4,D59,E59,D66,F66,D73,F73,D9 5,F95,D103,D104") '<----
Change


'Select the files with GetOpenFilename
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files,
*.xl*", _
MultiSelect:=True)
' Set FileNameXls = Workbooks.Open( _
' Filename:=PathStr & FileNameXls, _
' UpdateLinks:=0, _
' Password:="TopSecret", _
'WriteResPassword:="TopSecret")

'Set FileNameXls = ActiveWorkbook


If IsArray(FileNameXls) = False Then
'do nothing
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

'The links to the first workbook will start in row 2
RwNum = 1

For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = RwNum + 1
FinalSlash = InStrRev(FileNameXls(FNum), "\")
JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = JustFileName

'build the formula string
JustFileName = WorksheetFunction.Substitute(JustFileName, "'",
"''")
PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName
& "'!"

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(,
, xlR1C1))
If Err.Number < 0 Then
'If the sheet not exist in the workbook the row color will
be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1) _
.Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = _
"=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

' Use AutoFit to set the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit

MsgBox "The Summary is ready, save the file if you want to keep it"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub



"Ron de Bruin" wrote:

Hi Frank

You posted a few times this week but I hade no time to answer

Ado will not work with password protected workbooks
If it is one password for all workbooks use my Add-in to get the info
http://www.rondebruin.nl/merge.htm

Or use the code here
http://www.rondebruin.nl/copy3.htm
Read the tips part




--

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




"Frank Situmorang" wrote in message
...
Hello,

In a server, I have about 300 workbooks in a server. All the workbooks are
indentical and have sheet named " SUMMARY". Without bothering people who
maybe using it, how can I get the information of each worksheet from the cell
range:
Range("C7,C8,E7,D118,H5,D63,E63,D70,F70," & _
"D80,F80,D102,F102,D108,D109")

and summaryize it in a workbook without opening each workbook. Should we use
ADO or DAO to do it?, Please help.

For your information if we open the workbook manuallly it prompts us to kein
the password, which is a window password, say "TopSecret", all the same
password for each workbook.

Thanks in advance,

Frank