Web sunucusundaki Dosyaları Listeleme

[agent1980]

Merhaba arkadaşlar;

Sub Start()
Dim klasor As Object
 
Set klasor = CreateObject("Shell.Application").BrowseForFolder _
                    (0, "Lütfen bir klasor seçin !", 1)
                    
Liste (klasor.Items.Item.Path)
AltListe (klasor.Items.Item.Path)
 
Set klasor = Nothing
End Sub
 
Private Sub Liste(yol As String)
Dim dosya As String, i As Long
 
    dosya = Dir(yol & "\*.*")
    i = 1
    While dosya <> ""
        DoEvents
        i = i + 1
        Cells(i, 1) = yol & dosya
        dosya = Dir
    Wend
End Sub
 
Private Sub AltListe(yol As String)
Dim fL As Object, f As Object, dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
 
On Error GoTo sonraki
For Each f In fL
    dosya = Dir(f.Path & "\*.*")
    
    While dosya <> ""
        DoEvents
        j = [a65000].End(3).Row + 1
        Cells(j, 1) = yol & "\" & dosya
        dosya = Dir
    Wend
    
    AltListe (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

Bu kod ile seçtiğim klasör altındaki tüm dosyaları listeleyebiliyorum.

Bunun yanı sıra sharepoint web sunucusunda belirli klasörler altında bir çok dosyamız mevcut.
Örnek Adres:
https://sharepoint/Documents/dosya1.doc
https://sharepoint/Documents/Klasör/dosya2.doc gibi

Bu dosyaları windows explorer görünümünde açabiliyoruz.


https://sharepoint/Documents adresini gösterip excelin her klasöre girip dosyanın ismini A sütununa dosya yolunu ise B sütununa yazmasını nasıl sağlarız.

Teşekkürler.

 

[mancubus]

google'dan şöyle bir şey buldum.

benim test etme imkanım yok.

belki iş görür.

("\\SharePointServer\Path\MorePath\DocumentLibrary\Folder")
yerine kendi yolunuzu yazacaksınız.

Public Sub ListFiles() 
    Dim folder As folder 
    Dim f As File 
    Dim fs As New FileSystemObject 
    Dim RowCtr As Integer 
 
    RowCtr = 1 
    Set folder = fs.GetFolder("\\SharePointServer\Path\MorePath\DocumentLibrary\Folder") 
    For Each f In folder.Files 
       Cells(RowCtr, 1).Value = f.Name 
       RowCtr = RowCtr + 1 
    Next f 
End Sub