Ana klasöre bağlı eşleştirme yaparak alt klasörleri dolu yada boş olmasına göre excel'e veri yazdırmak

[Hoksisamuray1]

Merhabalar, Benim ekli kodum var. Burada B sütünündaki mağaza koduna göre ana dosya olan “Lokasyon Görseller” altındaki klasörlerin mağaza kodları uyuşanları buluyor ve bu klasörlere ait H sütunundaki ilgili hücreye link ekliyor.

Ama benim aslında yapmak istediğim B sütünündaki mağaza koduna göre ana dosya olan “Lokasyon Görseller” altındaki klasörlerin mağaza kodları uyuşanları bulsun. Bulduğu klasörler içinde dosya varmı baksın.
Eğer klasör bulunamazsa "Klasör Bulunamadı", klasör var ama görsel yoksa "Görsel Yok", görsel varsa "Görsel Var" şeklinde H sütunundaki ilgili hücreye not ve link eklensin istiyorum. Bu sayede linkini getirdiğim klasörlerden hangisinde görsel var veya yok bileyim. Buna konuda yardımcı olabilir misiniz?

Sub KlasorleriBulVeLinkEkle()
Dim ws As Worksheet
Dim cell As Range
Dim MagazaID As String
Dim lastModifiedFolder As String
Dim lastModifiedDate As Date

' Çalışma sayfasını tanımlayın (müşteri listesi olan sayfa)
Set ws = ThisWorkbook.Sheets("TR_RawData") ' Gerekirse sayfa adını güncelleyin

' Tarama yapılacak ana klasörleri tanımlayın
Dim klasorler(1 To 19) As String
klasorler(1) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\AVM\Aday"
klasorler(2) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\AVM\Aktif"
klasorler(3) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\AVM\Pasif"
klasorler(4) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Belediye\Aday"
klasorler(5) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Belediye\Aktif"
klasorler(6) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Belediye\Pasif"
klasorler(7) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Carrefour\Aday"
klasorler(8) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Carrefour\ Aktif"
klasorler(9) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Carrefour\ Pasif"
klasorler(10) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Koçtaş\Aday"
klasorler(11) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Koçtaş\Aktif"
klasorler(12) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Koçtaş\Pasif"
klasorler(13) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Migros\Aday"
klasorler(14) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Migros\Aktif"
klasorler(15) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Migros\Pasif"
klasorler(16) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Özel Mülk\Aday"
klasorler(17) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Özel Mülk\Aktif"
klasorler(18) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Özel Mülk\Pasif"
klasorler(19) = "\\10.100.5.2\mora ortak\File System\Ortak\MORA GAYRIMENKUL\Lokasyon Görseller\Seyhanlar\Pasif"

' B sütunundaki MağazaID'leri tarar (örneğin, B2'den başlar)
For Each cell In ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
MagazaID = cell.Value ' B sütunundaki MağazaID'yi alır

' En güncel klasör bilgilerini sıfırlayın
lastModifiedDate = 0
lastModifiedFolder = ""

' Her klasör yolu için arama yap
Dim i As Integer
For i = LBound(klasorler) To UBound(klasorler)
Call KlasorleriTara(klasorler(i), MagazaID, lastModifiedFolder, lastModifiedDate)
Next i

' En güncel klasör bulunduysa, H sütununa link ekle
If lastModifiedFolder <> "" Then
ws.Cells(cell.Row, "H").Hyperlinks.Add Anchor:=ws.Cells(cell.Row, "H"), _
Address:=lastModifiedFolder, TextToDisplay:="Klasör Linki"
Else
ws.Cells(cell.Row, "H").Value = "Klasör Bulunamadı"
End If
Next cell

MsgBox "Tüm MağazaID'ler için klasörlerde arama tamamlandı.", vbInformation
End Sub

' Alt klasörlerde tarama yapan rekürsif fonksiyon
Sub KlasorleriTara(klasorYolu As String, MagazaID As String, ByRef lastModifiedFolder As String, ByRef lastModifiedDate As Date)
Dim file As String
Dim folderPath As String
Dim folderDate As Date

' İlk olarak mevcut klasörde MağazaID ile başlayan klasörleri kontrol edin
file = Dir(klasorYolu & "\" & "*" & MagazaID & "*", vbDirectory)

Do While file <> ""
If (GetAttr(klasorYolu & "\" & file) And vbDirectory) = vbDirectory Then
folderPath = klasorYolu & "\" & file

' Klasörün gerçekten var olup olmadığını kontrol edin
If Dir(folderPath, vbDirectory) <> "" Then
' Klasörün son değiştirilme tarihini al
folderDate = FileDateTime(folderPath)

' Eğer bu klasör en güncel klasörse bilgileri sakla
If folderDate > lastModifiedDate Then
lastModifiedDate = folderDate
lastModifiedFolder = folderPath
End If
End If
End If

' Sonraki klasöre geç
file = Dir
Loop
End Sub