Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
GetOpen filename to open files(Workbooks)
Hello,
Below VBA works perfectly for non passwords. How can we incorporate Getopenfile with opening the protoecting workbooks ( all workbooks have the same password. The following VBA is debugging at: 'Set FileNameXls = Workbooks.Open(PathStr & FileNameXls),_ 'Password:="topsecret", WriteResPassword:="topsecret", UpdateLinks:=0) This is my whole VBA that I learned from the website of Mr. Ron De Bruin: 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(PathStr & FileNameXls),_ 'Password:="topsecret", WriteResPassword:="topsecret", UpdateLinks:=0) 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 Thanks a lot in adavance Frank |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Workbooks.Open Filename:=.UpdateLinks:=0, IgnoreReadOnlyRecommended:=True | Excel Discussion (Misc queries) | |||
Workbooks.Open Filename | Excel Worksheet Functions | |||
set filename to <filename-date on open | Excel Worksheet Functions | |||
why does excel 2002 add a '1' to the filename everytime I open a f | Excel Discussion (Misc queries) | |||
Global Setting For All Workbooks - Filename In Footer | Excel Worksheet Functions |