wie kann ich das so erweitern, dass immer das aktuell laufende Dokument eingetragen wird.
Damit diese Meldung ersetzt wird und diese Einstellung erspart wird.
Menü Datei --> Eigenschaften
Register "Beschreibung"
Im Feld "Titel"
Code: Alles auswählen
REM ***** BASIC *****
Option Explicit
REM Dieses Makro speichert eine Backupdatei mit Zeitstempel
REM Hier ggf. den Pfad zur Speicherung der Backup-Datei anpassen
Const sPath="H:\__Back_Libre\"
Sub xBackup
Dim oDoc as Object
Dim xDoc as Variant
Dim sFName as String
Dim sSuffix as String
Dim datei as String
Dim dateiurl as String
Dim dummy()
' Referenz auf aktuelles Dokument
oDoc=ThisComponent
' Es muss unter Menü Datei\Eigenschaften
' Register: Beschreibung --> Titel
' der Dateiname (ohne Extension) im Feld Titel eingegeben werden.
' Wenn dieses vergessen wurde startet folgende Messagebox und das Programm wird beendet
If oDoc.DocumentProperties.Title ="" Then
msgbox "Kein Titel!" & chr(13) & "Bitte fügen Sie einen Titel unter" & chr(13) & _
"Menü Datei --> Eigenschaften..." & chr(13) & "Register 'Beschreibung' ein! " _
,16, "Dokumenteigenschaften nicht vollständig!"
Exit sub
Else
' Auslesen der Dokumenteigenschaft "Titel"
sSuffix = oDoc.DocumentProperties.Title
End if
'mri oDoc
' geöffneten Dokumententyp ermitteln und Dateiname zusammensetzen:
' Dateiname = Präfix & Datum mit Zeit & Suffix & Extension
' WRITER
If oDoc.SupportsService("com.sun.star.text.TextDocument") THEN
xDoc = array(sSuffix, format(now,"YYYY-MM-DD"), format(now, "hhmmss"), "Backup.odt")
' CALC
ElseIf oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") THEN
xDoc = array(sSuffix, format(now,"YYYY-MM-DD"), format(now, "hhmmss"), "Backup.ods")
' IMPRESS
ElseIf oDoc.SupportsService("com.sun.star.presentation.PresentationDocument") THEN
xDoc = array(sSuffix, format(now,"YYYY-MM-DD"), format(now, "hhmmss"), "Backup.odp")
' DRAW
ElseIf oDoc.SupportsService("com.sun.star.drawing.DrawingDocument") THEN
xDoc = array(sSuffix, format(now,"YYYY-MM-DD"), format(now, "hhmmss"), "Backup.odg")
' MATH
ElseIf oDoc.SupportsService("com.sun.star.formula.FormulaProperties") THEN
xDoc = array(sSuffix, format(now,"YYYY-MM-DD"), format(now, "hhmmss"), "Backup.odf")
Else
' Fehler abfangen, wenn kein passendes Programm geöffnet ist.
' Erfolgt z.B. von Base geöffnet und vordergründig ist
Msgbox "Es ist ein Fehler aufgetreten" & chr(10) & "Das Programm wird beendet",15
Exit Sub
END IF
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Dateiname (sFName) aus xDoc zusammensetzen.
' z.B.
' [Titel aus den Dokumenteigenschaften]__2018-04-10_135046_Backup.odt
'
' Suffix = entspricht dem Titel aus den Dokumenteigenschaften
' Datum = _2018-04-10
' Uhrzeit _135046 (13:50:46)
' Praefix = _Backup
' Extension = .odt (Wird gemäß obige Abfrage [Dokumentyp] ermittelt.
sFName=join(xDoc, "_")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Speicherung in hier angegebenen Pfad und mti Dateiname (sFName)
sFName =sPath & sFName
datei=sFName
dateiurl=converttourl(datei)
odoc=thisComponent
' Speicherung
odoc.storeasurl(dateiurl,dummy())
End Sub