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