I hope I am doing this right. This is my first question on Stackoverflow and I am pretty raw when it comes to Excel.
In the code below I am opening 20 workbooks in succession. The problem I have is that each workbook requests the user to click "yes" to open as read only or "no" to allow editing. Thus I have to hit "TAB" and "ENTER" (or click "No") for each workbook.
I would like to automatically apply the TAB and ENTER from within the code (hands free)
'Name macro
Sub SearchWKBooks()
'Dimension variables and declare data types
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
'Create a new worksheet and svae it to object named WS
Set WS = Sheets.Add
'Show dialog box and ask for a folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
'Save selected folder path to variable myfolder
myfolder = .SelectedItems(1) & "\"
End With
'Show inputbox and ask for search string to use
Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)
'Stop macro if string is nothing
If Str = "" Then Exit Sub
'Save text "Search string:" to cell A1 on worksheet WS
WS.Range("A1") = "Search string:"
'Save text in variable Str to cell B1 on worksheet WS
WS.Range("B1") = Str
'Save text "Path:" to cell A2 on worksheet WS
WS.Range("A2") = "Path:"
'Save text in variable myfolder to cell B2 on worksheet WS
WS.Range("B2") = myfolder
'Save text "Workbook" to cell A3 on worksheet WS
WS.Range("A3") = "Workbook"
'Save text "Worksheet" to cell B3 on worksheet WS
WS.Range("B3") = "Worksheet"
'Save text "Cell Address" to cell C3 on worksheet WS
WS.Range("C3") = "Cell Address"
'Save text "Link" to cell D3 on worksheet WS
WS.Range("D3") = "Link"
'Save 0 (zero) to variable a
a = 0
' The DIR function returns the first filename that matches the pathname specified in variable myfolder and save it to variable Value
Value = Dir(myfolder)
'Keep iterating until variable Value is nothing
Do Until Value = ""
'Check if Value is . or ..
If Value = "." Or Value = ".." Then
'If Value is not . or .. execute these lines of code
Else
'Check If file names last three characters match xls or four last characters match xlsx or xlsm
If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
'Enable error handling
On Error Resume Next
'Open workbook based on path in variable folder and file name in variable Value using password zzzzzzzzzzzz
Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
'Check if an error has occured
If Err.Number > 0 Then
'Save path to column A based on counter variable a
WS.Range("A4").Offset(a, 0).Value = Value
'Save text "Password protected" to column B based on counter variable a
WS.Range("B4").Offset(a, 0).Value = "Password protected"
'Add 1 to the number stored in variable a
a = a + 1
'Continue here if no error is returned
Else
'Disable error handling
On Error GoTo 0
'Go through all worksheets in active workbook
For Each sht In ActiveWorkbook.Worksheets
'Seach worksheet based on value in variable Str and save result to object c
Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
'Check if object c is not nothing
If Not c Is Nothing Then
'Save address based on range object c to variable firstAddress
firstAddress = c.Address
'Repet following lines between Do and Loop
Do
'Save file name to column A and row number based on variable a
WS.Range("A4").Offset(a, 0).Value = Value
'Save worksheet name to column B and row number based on variable a
WS.Range("B4").Offset(a, 0).Value = sht.Name
'Save cell address to column C and row number based on variable a
WS.Range("C4").Offset(a, 0).Value = c.Address
'Create hyperlink pointing to file name , worksheet name and cell address, show hyperlink text "Link"
WS.Hyperlinks.Add Anchor:=WS.Range("D4").Offset(a, 0), Address:=myfolder & Value, SubAddress:= _
sht.Name & "!" & c.Address, TextToDisplay:="Link"
'Increase count variable a with 1
a = a + 1
'Find next cell that matches and save to object c
Set c = sht.Cells.FindNext(c)
'Keep iterating until c is nothing and c is not equal to the first found cell in the same worksheet
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
'Continue with next worksheet
Next sht
End If
'Close workbook and do not save any changes made
' GIO Workbooks(Value).Close False
'Diable error handling
On Error GoTo 0
End If
End If
'Find next file
Value = Dir
'Keep iterating
Loop
'Change cell widths to fit text
Cells.EntireColumn.AutoFit
End Sub