Kapalı kitaplarda arama makrosu, şifre sorunu

[Yavuzdan]

Merhaba,

Bir klasör altında bulunan tüm Excel dosyalarında text arama yapıyorum. Aşağıda verdiğim kodu kullanarak açılış şifresi olmayan dosyalarda sorunsuz arama yapabiliyorum.

Fakat bu kullandığım kod, açılış şifresi olan dosyaları malesef aramıyor ve atlıyor. Aşağıda kırmızı olan eklentiyi eklediğim halde şifreli dosyaları açmıyor. (dosyaların açılış şifresi "a")
Şifreli dosyaları açmak için nasıl bir düzenleme yapılması gerekir. Bu konuda lütfen yardımcı olabilirmisiniz.

Teşekkürler.

Sub SearchAndOpen()
Dim R As Range, FindMe As String, FileName As String, I As Integer, WS As Worksheet
Const Message As String = "Please enter the Address to search for in the box below:"
Const Title As String = "Address Search"
FindMe = InputBox(Message, Title)
If FindMe = "" Then Exit Sub
With Application.FileSearch
.LookIn = "c:\sgg"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
.TextOrProperty = FindMe
.MatchTextExactly = True
.Execute
If .FoundFiles.Count = 0 Then
MsgBox "No files Found. Check your spelling and try again"
End If
For I = 1 To .FoundFiles.Count
FileName = .FoundFiles(I)
Workbooks.Open (FileName), [COLOR="Red"]Password:="a"[/COLOR]
For Each WS In ActiveWorkbook.Worksheets
Set R = WS.Cells.Find(What:=FindMe, After:=WS.Range("B1"), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not R Is Nothing Then
Application.Goto R, Scroll:=True
Exit For
End If
Next WS
Next I
End With
End Sub

 

[Yavuzdan]

Örnek dosyaları ekte gönderiyorum..

Bu konuda yardımcı olabilecek arkadaşlara şimdiden teşekkürler.

 

[halit3]

Alternatif kod

Dim aranan As String
Sub deneme()

aranan = InputBox("Aranan kelimeyi yaz", "başlık", "yavuz")
If Trim(aranan) = "" Then Exit Sub
Kaynak = "c:\sgg"
Liste (Kaynak)
MsgBox "işlem tamam"

End Sub

Private Sub Liste(yol As String)
Dim fs As Object, f As Object, j As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Application.DisplayAlerts = False
Dim wb As Workbook
For Each dosya In fs.GetFolder(yol).Files
uzanti = fs.GetExtensionName(dosya)

If uzanti = "xls" Then
If ThisWorkbook.Name <> dosya.Name Then

Set wb = Workbooks.Open((dosya), Password:="a")
deg = 0
Dim Rng As Range
For Each WS In ActiveWorkbook.Worksheets


With Sheets(WS.Name).Range("A:z")
Set Rng = .Find(What:=aranan, After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
deg = 1

Exit For
Else
'MsgBox "Sonuç yok"
End If
End With
Next WS

If deg = 0 Then
wb.Close False
End If

End If
End If
Next

On Error GoTo sonraki
For Each f In fs.GetFolder(yol).subfolders
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[Yavuzdan]

Alternatif kod

Dim aranan As String
Sub deneme()

aranan = InputBox("Aranan kelimeyi yaz", "başlık", "yavuz")
If Trim(aranan) = "" Then Exit Sub
Kaynak = "c:\sgg"
Liste (Kaynak)
MsgBox "işlem tamam"

End Sub

Private Sub Liste(yol As String)
Dim fs As Object, f As Object, j As Long
Set fs = CreateObject("Scripting.FileSystemObject")
Application.DisplayAlerts = False
Dim wb As Workbook
For Each dosya In fs.GetFolder(yol).Files
uzanti = fs.GetExtensionName(dosya)

If uzanti = "xls" Then
If ThisWorkbook.Name <> dosya.Name Then

Set wb = Workbooks.Open((dosya), Password:="a")
deg = 0
Dim Rng As Range
For Each WS In ActiveWorkbook.Worksheets


With Sheets(WS.Name).Range("A:z")
Set Rng = .Find(What:=aranan, After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not Rng Is Nothing Then
Application.GoTo Rng, True
deg = 1

Exit For
Else
'MsgBox "Sonuç yok"
End If
End With
Next WS

If deg = 0 Then
wb.Close False
End If

End If
End If
Next

On Error GoTo sonraki
For Each f In fs.GetFolder(yol).subfolders
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

Halit hocam Merhaba,

Paylaştığınız kod sorunsuz çalıştı.

Yardımlarınız için teşekkürler..

 

[halit3]

Halit hocam Merhaba,

Paylaştığınız kod sorunsuz çalıştı.

Yardımlarınız için teşekkürler..

İyi çalışmalar