Automatisierte Ordnerstruktur auf Sharepoint per VBA erstell
26.09.2023 17:39:25
marie_excel
ich bin gerade dabei eine Checkliste zu digitalisieren, welche ich mit Checkboxen (CB) versehen habe.
Bei Aktivierung der CB wird automatisch die Zeit in der Zelle rechts daneben vermerkt.
Nun möchte ich gerne über VBA ein Makro schreiben, welches über einen CommandButton das Arbeitsblatt in einer automatisch erstellten Ordnerstruktur speichert.
Die Ordnerstruktur soll zuerst gemäß des Wertes aus Zelle D7 und dann entsprechend des Datums in Zelle I9 nach Jahr, Monat und Tag übernommen und automatisch erstellt werden. Der Dateiname soll dem Wert aus Zelle D9 entsprechen.
Lokal hat das auch super geklappt :) Nur möchte ich das Ganze jetzt auf Sharepoint machen und stoße hier leider an meine Grenzen.
Ich kriege eine Fehlermeldung, dass das Dokument entweder geöffnet ist, oder nicht abgespeichert werden kann. Der Debugger zeigt auf den Schritt "' Arbeitsblatt "LF Checkliste" als PDF auf SharePoint speichern"
Ich danke euch allen schon mal vorab recht herzlich für Unterstützung! Bitte bezüglich der Antworten beachten, dass ich nicht gerade ein VBA Profi bin :) Danke!!
Hier mein Code:
Sub SpeichernAufSharePoint()
Dim Dateiname As String
Dim D11Wert As String ' Neuer Name für den Wert in Zelle D11
Dim BenutzerdefiniertesDatum As Date
Dim Jahr As String
Dim Monat As String
Dim Tag As String
Dim Speicherpfad As String
Dim ws As Worksheet
Dim cb As Checkbox
Dim checkboxCell As Range
' Speicherpfad auf SharePoint
Speicherpfad = "Beispiel-Link" ' Hier die SharePoint-URL anpassen
' Wert für den ersten Ordner
D11Wert = ThisWorkbook.Sheets("LF Checkliste").Range("D11").Value
' Wert für den Dateinamen
Dateiname = ThisWorkbook.Sheets("LF Checkliste").Range("D7").Value
' Benutzerdefiniertes Datum aus Zelle I9
BenutzerdefiniertesDatum = ThisWorkbook.Sheets("LF Checkliste").Range("I9").Value
' Extrahiere Jahr, Monat und Tag
Jahr = Year(BenutzerdefiniertesDatum)
Monat = Format(Month(BenutzerdefiniertesDatum), "00")
Tag = Format(Day(BenutzerdefiniertesDatum), "00")
' Erstelle Ordnerstruktur (falls nicht vorhanden) auf SharePoint
MkDirOnSharePoint Speicherpfad & D11Wert
MkDirOnSharePoint Speicherpfad & D11Wert & "/" & Jahr
MkDirOnSharePoint Speicherpfad & D11Wert & "/" & Jahr & "/" & Monat
MkDirOnSharePoint Speicherpfad & D11Wert & "/" & Jahr & "/" & Monat & "/" & Tag
' Arbeitsblatt "LF Checkliste" als PDF auf SharePoint speichern
ThisWorkbook.Sheets("LF Checkliste").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Speicherpfad & D11Wert & "/" & Jahr & "/" & Monat & "/" & Tag & "/" & Dateiname & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Zurücksetzen der Checkboxen und Sperren der Zellen daneben
Set ws = ThisWorkbook.Sheets("LF Checkliste")
For Each cb In ws.CheckBoxes
cb.Enabled = True ' Aktiviere die Checkbox
cb.Value = xlOff ' Checkbox auf "nicht angehakt"
' Setze die benachbarte Zelle zurück
Set checkboxCell = cb.TopLeftCell.Offset(0, 1)
checkboxCell.ClearContents
Next cb
' Erfolgsmeldung
MsgBox "Das Arbeitsblatt 'LF Checkliste' wurde als PDF auf SharePoint gespeichert, und die Checkboxen und Uhrzeiten wurden zurückgesetzt."
End Sub
Sub MkDirOnSharePoint(ByVal path As String)
' Funktion zum Erstellen von Verzeichnissen auf SharePoint
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
objFSO.CreateFolder path
On Error GoTo 0
Set objFSO = Nothing
End SubHier auch nochmal mein Code zur lokalen Speicherung, welcher wunderbar funktioniert hat.
Sub Speichern()
Dim Dateiname As String
Dim D11Wert As String ' Neuer Name für den Wert in Zelle D11
Dim BenutzerdefiniertesDatum As Date
Dim Jahr As String
Dim Monat As String
Dim Tag As String
Dim Speicherpfad As String
Dim ws As Worksheet
Dim cb As Checkbox
Dim checkboxCell As Range
' Speicherpfad lokal
Speicherpfad = "C:\Users\Beispiel\Beispiel\"
' Wert für den ersten Ordner
D11Wert = ThisWorkbook.Sheets("LF Checkliste").Range("D11").Value
' Wert für den Dateinamen
Dateiname = ThisWorkbook.Sheets("LF Checkliste").Range("D7").Value
' Datum aus Zelle I9
BenutzerdefiniertesDatum = ThisWorkbook.Sheets("LF Checkliste").Range("I9").Value
' Extrahiere Jahr, Monat und Tag
Jahr = Year(BenutzerdefiniertesDatum)
Monat = Format(Month(BenutzerdefiniertesDatum), "00")
Tag = Format(Day(BenutzerdefiniertesDatum), "00")
' Erstelle Ordnerstruktur (falls nicht vorhanden)
If Dir(Speicherpfad & D11Wert, vbDirectory) = "" Then MkDir Speicherpfad & D11Wert
If Dir(Speicherpfad & D11Wert & "\" & Jahr, vbDirectory) = "" Then MkDir Speicherpfad & D11Wert & "\" & Jahr
If Dir(Speicherpfad & D11Wert & "\" & Jahr & "\" & Monat, vbDirectory) = "" Then MkDir Speicherpfad & D11Wert & "\" & Jahr & "\" & Monat
If Dir(Speicherpfad & D11Wert & "\" & Jahr & "\" & Monat & "\" & Tag, vbDirectory) = "" Then MkDir Speicherpfad & D11Wert & "\" & Jahr & "\" & Monat & "\" & Tag
' Speichere das Arbeitsblatt "LF Checkliste" als PDF
ThisWorkbook.Sheets("LF Checkliste").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Speicherpfad & D11Wert & "\" & Jahr & "\" & Monat & "\" & Tag & "\" & Dateiname & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
' Zurücksetzen der Checkboxen und Sperren der Zellen daneben
Set ws = ThisWorkbook.Sheets("LF Checkliste")
For Each cb In ws.CheckBoxes
cb.Enabled = True ' Aktiviere die Checkbox
cb.Value = xlOff ' Setze den Status der Checkbox auf "nicht angehakt"
' Setze die benachbarte Zelle zurück
Set checkboxCell = cb.TopLeftCell.Offset(0, 1)
checkboxCell.ClearContents
Next cb
' Erfolgsmeldung
MsgBox "Das Arbeitsblatt 'LF Checkliste' wurde als PDF gespeichert, und die Checkboxen und Uhrzeiten wurden zurückgesetzt."
End Sub