LibreOffice-Forum

Code: Alles auswählen

REM  *****  BASIC  *****
Option Explicit
REM Dieses Makro speichert eine Backupdatei mit Zeitstempel 
REM in den Ordner C:\Temp
REM Habe folgenden Shortcut zum Ausführen des Makros zugewiesen --> STRG+,
REM Die Einrichtung des Shortcuts muss manuell im Menü Extras --> Anpassen --> Tastatur vorgenommen werden.

REM Hier ggf. den Pfad zur Speicherung der Backup-Datei anpassen
Const sPath="C:\Temp\"

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