Ich Lokal auf meinem PC kann ich eine objektliste aus einem Ordner erstellen in dem Ich den direkten Pfad mit angebe. Das ganze tool soll jetzt in die Cloud wandern doch ein aufruf der Sharepoint url ist nicht möglich. Die URL wird hier definiert nur leider klappt das nicht für online pfade.

Set objFileSystem = CreateObject("scripting.FileSystemObject")

' Angabe auf den Ordner, der ausgelesen werden soll
Set objVerzeichnis = objFileSystem.GetFolder("https://xxx.sharepoint.com/:f:/r/teams/Teamxx-110FileShare/Shared%20Documents/110%20FileShare/x/Test1?csf=1&web=1&e=GgxwiU")
Set objDateienliste = objVerzeichnis.Files



Folgend der gesamte code :

Option Explicit

Sub Dateien_Auflisten_Archivieren()

Dim eingabe As String
Dim lngZeile As Long
Dim lngZeile2 As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object
Dim StringURL As String
Dim ws1 As Worksheet
Dim rng As Range
Dim foundCell As Range

StringURL = "https://xxx.sharepoint.com/:f:/r/teams/Teamx-110FileShare/Shared%20Documents/110%20FileShare/x/Test1?csf=1&web=1&e=GgxwiU"
Set objFileSystem = CreateObject("scripting.FileSystemObject")

' Angabe auf den Ordner, der ausgelesen werden soll
Set objVerzeichnis = objFileSystem.GetFolder("https://xxx.sharepoint.com/:f:/r/teams/Teamxx-110FileShare/Shared%20Documents/110%20FileShare/x/Test1?csf=1&web=1&e=GgxwiU")
Set objDateienliste = objVerzeichnis.Files

' Hier wird angefangen zu schreiben und die letzte Zeile in Spalte 1 gezählt in x
lngZeile = 0

' Arbeitsblätter (Tabellen) 1 und 2 festlegen
Set ws1 = ThisWorkbook.Sheets("x") ' Anpassen an den Namen deines Arbeitsblatts


' Bildschirmdarstellung Ausschalten
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


For Each objDatei In objDateienliste
' Angabe nach welchen Dateityp gesucht werden soll. Hier wird die Methode Right verwendet, um die letzten 4 Zeichen des Namens des Objekts objDatei zu extrahieren. Dann wird die Methode LCase verwendet, um den extrahierten Teil in Kleinbuchstaben umzuwandeln. Schließlich wird überprüft, ob dieser Teil gleich ".jpg" ist.
If Not objDatei Is Nothing And Right(LCase(objDatei.Name), 4) = ".jpg" Then

' MsgBox für die erste Frage mit "Ja" oder "Nein" Optionen

If MsgBox("Möchten Sie eine A2V-Nummer eingeben?", vbQuestion + vbYesNo, "A2V-Nummer eingeben?") = vbNo Then
Exit Sub ' Beendet das Programm
End If

' InputBox für die A2V-Nummer
Do

eingabe = InputBox("Bitte geben Sie die A2V-Nummer ein", "A2V-Nummer muss groß geschrieben sein", ActiveCell)


' Überprüfen, ob das Feld leer ist
If KeineEingabe(eingabe) Then
Exit Sub
End If

' Überprüfen, ob das Feld leine Gültige A2V nummer hat
If Not IsValidA2VNummer(eingabe) Then
MsgBox "Ungültige A2V-Nummer. Bitte korrigieren Sie die Eingabe.", vbExclamation, "Ungültige Eingabe"
End If

Loop While Not IsValidA2VNummer(eingabe)

' In Tabelle 2 nach dem Wert in der Variable eingabe suchen(Materialnummer)
Set foundCell = ws1.Range("C:C").Find(What:=eingabe, LookIn:=xlValues, LookAt:=xlWhole)
lngZeile = foundCell.Offset(0, 0).Row

' Ausgabe des Hyperlinks in Zeile und Spalte
lngZeile2 = Cells(lngZeile, Columns.Count).End(xlToLeft).Column
ws1.Hyperlinks.Add ws1.Cells(lngZeile, lngZeile2 + 1), Address:=StringURL & "Archiv\" & objDatei.Name

' Verschiebe die Datei ins Archivverzeichnis
objDatei.Move StringURL & "Archiv\" & objDatei.Name

End If

Next objDatei

' Bildschirmdarstellung wieder einschalten
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Function IsValidA2VNummer(ByVal value As String) As Boolean
' Prüft, ob der Wert eine gültige A2V-Nummer ist (Großbuchstaben und Länge 14)
IsValidA2VNummer = (Left(value, 3) = "A2V" And Len(value) = 14)
End Function
Function KeineEingabe(ByVal value As String) As Boolean
' Prüft, ob der Wert eine gültige A2V-Nummer ist (Großbuchstaben und Länge 14)
KeineEingabe = value = ""
End Function


Das ist der Code