Dateien aus Pfad auslesen

[xlsxvba]

Moin zusammen,



ich hoffe ich mach kein neues Fass auf - aber laut Suche habe ich das so noch nicht gefunden :)



Und zwar möchte ich folgendes Makro nutzen und ergänzen:



Was es aktuell macht: es liest aus einem Pfad aus:



- Dateiname.

- File / Folder

- relativer Pfad



Ich frage mich nun, wie ich es ergänzen kann, damit in zwei weiteren Spalten zusätzlich ausgegeben werden:



- Dateiendung

- Absoluter Pfad



Makro:

Code:

Sub DownloadListFromSharepoint()

    Dim SharepointAddress As String
    Dim LocalAddress As String
    Dim objFolder As Object
    Dim objNet As Object
    Dim objFile As Object
    Dim FS As Object
    Dim rng As Range
    SharepointAddress = "https://abc.onmicrosoft.com/TargetFolder/"

    Set objNet = CreateObject("WScript.Network")
    Set FS = CreateObject("Scripting.FileSystemObject")
    objNet.MapNetworkDrive "A:", SharepointAddress
   
    Set objFolder = FS.getfolder("A:")
   
    Set rng = ThisWorkbook.Worksheets(1).Range("a1")
    rng.Value = "File Name"
    rng.Offset(0, 1).Value = "Folder/File"
    rng.Offset(0, 2).Value = "Path"
    GetAllFilesFolders rng, objFolder, "" & strSharepointAddress
    objNet.RemoveNetworkDrive "A:"
    Set objNet = Nothing
    Set FS = Nothing

End Sub

Public Sub GetAllFilesFolders(rng As Range, ObjSubFolder As Object, strSharepointAddress As String)
    Dim objFolder As Object
    Dim objFile As Object
   
    For Each objFile In ObjSubFolder.Files
        rng.Offset(1, 0) = objFile.Name
        rng.Offset(1, 1) = "File"
        rng.Offset(1, 2) = Replace(objFile.Path, "A:\", SharepointAddress)
        Set rng = rng.Offset(1, 0)
    Next
    For Each objFolder In ObjSubFolder.subfolders
        rng.Offset(1, 0) = objFolder.Name
        rng.Offset(1, 1) = "Folder"
        rng.Offset(1, 2) = Replace(objFolder.Path, "A:\", SharepointAddress)
        Set rng = rng.Offset(1, 0)
        GetAllFilesFolders rng, objFolder, strSharepointAddress
    Next
End Sub

Habt ihr da einen Tipp für mich?

Wäre euch sehr dankbar ...



Best Grüße!

---

// sorry für die Formatierung ... konnte keine URL einfügen zur Quelle

[schauan]

Hallöchen,

im Moment scheint Dein code doch nur in Zeile 1 die Überschriften der Spalten einzutragen?
Zudem passt hier was nicht:
GetAllFilesFolders rng, objFolder, "" & strSharepointAddress

Die Funktion GetAllFilesFolders hast Du uns vorenthalten und die Variable strSharepointAddress müsste doch laut dem restlichen code SharepointAddress sein?

Poste doch bitte den code, der, wie von Dir beschrieben funktioniert, und die fehlende Funktion.

[xlsxvba]

Moin,

Danke für deine Antwort.
Ich habe den Code 1:1 übernommen, wie er auf der Seite beschrieben war und er funktioniert soweit auch. Die andere Funktion steht ganz unten im Code :) :

Code:

Now, use the below mentioned code and call the sub DownloadListFromSharepoint.

    Change the SharepointAddress = “https://abc.onmicrosoft.com/TargetFolder/” to your sharepoint address(Copied from windows explorer).
    Change the Range to wherever you want the list to be generated. Set rng = ThisWorkbook.Worksheets(1).Range(“a1”)


Sub DownloadListFromSharepoint()

    Dim SharepointAddress As String
    Dim LocalAddress As String
    Dim objFolder As Object
    Dim objNet As Object
    Dim objFile As Object
    Dim FS As Object
    Dim rng As Range
    SharepointAddress = "https://abc.onmicrosoft.com/TargetFolder/"

    Set objNet = CreateObject("WScript.Network")
    Set FS = CreateObject("Scripting.FileSystemObject")
    objNet.MapNetworkDrive "A:", SharepointAddress
   
    Set objFolder = FS.getfolder("A:")
   
    Set rng = ThisWorkbook.Worksheets(1).Range("a1")
    rng.Value = "File Name"
    rng.Offset(0, 1).Value = "Folder/File"
    rng.Offset(0, 2).Value = "Path"
    GetAllFilesFolders rng, objFolder, "" & strSharepointAddress
    objNet.RemoveNetworkDrive "A:"
    Set objNet = Nothing
    Set FS = Nothing

End Sub

Public Sub GetAllFilesFolders(rng As Range, ObjSubFolder As Object, strSharepointAddress As String)
    Dim objFolder As Object
    Dim objFile As Object
   
    For Each objFile In ObjSubFolder.Files
        rng.Offset(1, 0) = objFile.Name
        rng.Offset(1, 1) = "File"
        rng.Offset(1, 2) = Replace(objFile.Path, "A:\", SharepointAddress)
        Set rng = rng.Offset(1, 0)
    Next
    For Each objFolder In ObjSubFolder.subfolders
        rng.Offset(1, 0) = objFolder.Name
        rng.Offset(1, 1) = "Folder"
        rng.Offset(1, 2) = Replace(objFolder.Path, "A:\", SharepointAddress)
        Set rng = rng.Offset(1, 0)
        GetAllFilesFolders rng, objFolder, strSharepointAddress
    Next
End Sub

Von: officeaccelerators.wordpress.com/2015/01/29/vba-code-to-download-list-of-files-and-folders-from-sharepoint/

Viele Grüße

[schauan]

Hallöchen,

ok, hab's jetzt gesehen
kannst Du mal für die 3 bisherigen Daten ein Beispiel posten?

Was ist bei Dir der absolute Pfad? Soll bei Dir das A:\ drin bleiben?
In der Funktion hast Du Replace(objFile.Path, "A:\", SharepointAddress) Ersetze das dann durch objFile.Path

Es gibt z.B.
GetParentFolderName
GetExtensionName

Verwenden kannst DU das im Prinzip so:

Sub test()
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
MsgBox objFSO.GetExtensionName("c:\test\file.txt") & vbLf & objFSO.GetParentFolderName("c:\test\file.txt")
End Sub

[xlsxvba]

Moin und Danke Dir bis hierhin,

Bisher ist die Ausgabe die folgende (Tabelle):

File Name | Folder/File | Path
__________________________

File1.txt   | file            | TargetFolder/SubFolder/
Ordner    | folder       | TargetFolder/


Ich würde sie gerne wie folgt erweitern:

File Name | Folder/File | Path                      |  absoluter Pfad                                                | Dateiendung
_________________________________________________________________________________________

File1.txt   | file            | TargetFolder/SubFolder/ | eigeneSharePointAdresse/TargetFolder/SubFolder | txt
Ordner    | folder       | TargetFolder/                  | eigeneSharePointAdresse/TargetFolder/                |



Das A:\ kann drin bleiben für das Mapping. Muss soweit ich weiß auch, da SharePoint ... korrigiere mich aber gerne :)

[schauan]

Hallöchen,


Die Sharepointadresse und den SubFolder hast Du ja:

https://abc.onmicrosoft.com/TargetFolder/
in
strSharepointAddress

TargetFolder/SubFolder/
in
objFolder.Name

Die brauchst Du dann nur auszugeben, z.B.


rng.Offset(1, 3) = strSharepointAddress
oder
rng.Offset(1, 3) = strSharepointAddress & objFolder.Name

Wenn Du die Erweiterung nicht so ermitteln willst wie ich es schon mal geschrieben habe dann vielleicht so:

rng.Offset(1, 4) = Right(objFile.Name, InStr(1, StrReverse(objFile.Name), ".") - 1)

[xlsxvba]

Moin,

sorry für die späte Rückmeldung und Danke für deine Antwort!

Code:

rng.Offset(1, 4) = Right(objFile.Name, InStr(1, StrReverse(objFile.Name), ".") - 1)

funktioniert super :)

Den absoluten Pfad bekommen ich leider nicht raus...

Wenn ich

Code:

rng.Offset(1, 3) = strSharepointAddress & objFolder.Name

nutze, dann bekomme ich nur in einigen Zellen einzelne Namen eines Ordners z.B.

Meine Public Sub sieht nun so aus:

Code:

Public Sub GetAllFilesFolders(rng As Range, ObjSubFolder As Object, strSharepointAddress As String)
    Dim objFolder As Object
    Dim objFile As Object
   
   
    For Each objFile In ObjSubFolder.Files
        rng.Offset(1, 0) = objFile.Name
        rng.Offset(1, 1) = Right(objFile.Name, InStr(1, StrReverse(objFile.Name), ".") - 1)
        rng.Offset(1, 2) = "File"
        rng.Offset(1, 3) = Replace(objFile.Path, "A:\", SharepointAddress)
        'rng.Offset(1, 4) = SharepointAddress & objFolder.Name
        Set rng = rng.Offset(1, 0)
    Next
    For Each objFolder In ObjSubFolder.subfolders
        rng.Offset(1, 0) = objFolder.Name
        'rng.Offset(1, 1) = Right(objFile.Name, InStr(1, StrReverse(objFile.Name), ".") - 1)
        rng.Offset(1, 2) = "Folder"
        rng.Offset(1, 3) = Replace(objFolder.Path, "A:\", SharepointAddress)
        rng.Offset(1, 4) = strSharepointAddress & objFolder.Name
        Set rng = rng.Offset(1, 0)
        GetAllFilesFolders rng, objFolder, strSharepointAddress
    Next
   
   
End Sub

Was mache ich falsch?
Danke Dir und viele Grüße!

[schauan]

Hallöchen,

ich hab ja schon mal geschrieben, dass mit Deinen Variablenbezeichnungen bisschen was nicht stimmt. Schreib mal ganz oben in Deinem Modul

Option Explicit

Dein zweites Sub beginnt mit

Public Sub GetAllFilesFolders(rng As Range, ObjSubFolder As Object, strSharepointAddress As String)

Im Code verwendest Du öfter SharepointAddress

Da steht aber nix drin ... Eventuell hilft es schon, wenn Du da überall das str davor setzt.

[xlsxvba]

Moin!
Danke erst einmal für deine Hilfe!
Ich habe es vorest so belassen - reicht im Prinzip auch schon so ohne dem absoluten Pfad. Muss ich mit mehr Zeit nochmal ran.

Schönes WE und viele Grüße :)