Klasörde bulunan dosya ismine göre hücreye farklı ismin atanması

[hesrefoglu]

Merhaba
Aşağıdaki kodlarla database dosyasında son 100 kaydın sadece kayıt numarasını alarak foto sayfasına yazdırıyorum.
Daha sonra her bir kayıt numarası ile c:\proex\Fotograflar\" & TextBox1.Value & "\" adresinde her biri kayıt numarası ile aynı adla olan klasör içindeki fotoğrafları kontrol ediyorum.
klasördeki foto isimlerine görede ( cim, dscn, img gibi ) kimin fotoğrafları çektiğini anlayarak kayıt numaralarının bulunduğu sütünun yanına yazdırıyorum.

Sorunum bu işlemin sadece resimlerin bulunduğu bilgisayardan yapılıyor olması, istediğim ise başka bilgisayardan da ağ yolu girilerek (\\server\proex\Fotograflar\" & TextBox1.Value & "\" ) gibi bu işlemin yapılabilmesi ama sanırım

ChDir (dosya2)

dosya = Dir("Cimg*.jpg")
a = ds.FileExists(dosya) kodları sadece işlemin yapıldığı PC de geçerli oluyor.

Sorunu çözmemde yardımcı olursanız sevinirim

Kodların aşağıdadır.

Dim dosya2 As Variant
Windows("proex.xls").Activate
Sheets("foto").Visible = -1
Sheets("foto").Select
Range("A1:B100").Select
Selection.ClearContents
Windows("database.xls").Activate
r = WorksheetFunction.CountA(Range("A:A")) + 2
u = r - 100

Range("b" & u & ":b" & r).Select
Selection.Copy

Windows("proex.xls").Activate
Sheets("foto").Select
Range("a1").Select
ActiveSheet.Paste

For x = 1 To 100
Windows("proex.xls").Activate
Sheets("foto").Select
TextBox1.Value = Cells(x, 1).Value
dosya2 = "c:\proex\Fotograflar\" & TextBox1.Value & "\"
b = ds.FolderExists(dosya2)
If b = True Then
GoTo 40
Else
GoTo 20
End If
40
ChDir (dosya2)

dosya = Dir("Cimg*.jpg")
a = ds.FileExists(dosya)
If a = True Then
Cells(x, 2).Value = "Kaan"
GoTo 20
Else
dosya = Dir("Dsc*.jpg")
b = ds.FileExists(dosya)
If b = True Then
Cells(x, 2).Value = "Murat"
GoTo 20
Else
dosya = Dir("Img*.jpg")
c = ds.FileExists(dosya)
If c = True Then
Cells(x, 2).Value = "Sinan"
GoTo 20
End If
End If
End If
20:
Next x