von omer » Di, 02.02.2016 16:08
Hallo F3K Total
Du hast ja recht. Ich dachte, in bin im openoffice-forum.de. Darum wurde Remo nicht angenommen. Ich habe da die Foren durch-
einander gebracht. Hier lautet mein Name auch Remo, nur Rückwärts.
Es hat zwar sehr lange gedauert, aber ich habe das Makro dann doch noch hinbekommen. Sicher umständlich, aber es funktioniert.
Ich kann nun Briefe automatisch mit Dateiname + Datum + laufende Nummer abspeichern.
Du kannst es Dir ja mal anschauen. Vielleicht gefällt es Dir.
Code: Alles auswählen
Sub MitDatumSpeichern()
Pfad = "W:\Eigene Dateien\OpenOffice\"
Pfad2 = "W:/Eigene%20Dateien/OpenOffice/"
Trenner = "_"
DateiZusatz = ".odt"
lngAnzahl = 200 ' Anzahl der laufenden Nummern
Exist = 5
rem -------------------------------------------------------------
SuchText = thiscomponent.title ' Datei ohne datum feststellen
OrgDatei = SuchText
SuchZeichen = "_" ' Altname bis "_" feststellen
Pos1 = Instr(SuchText,SuchZeichen)
If Pos1 > 0 Then AltName = Left(SuchText,Pos1-1)
If Pos1 > 0 Then DateiName = SuchText
Voreinstellung = AltName
Mldg = "Dateiname OHNE Datum eingeben !"
Titel = "Datei speichern"
DateiName = InputBox(Mldg, Titel, Voreinstellung)
If DateiName = "" then x = 2 : goto ende
Rem----------------------------------------------------------------
SuchText = Dateiname ' evtl, "_" entfernen
SuchZeichen = "_"
Pos1 = Instr(SuchText,SuchZeichen)
If Pos1 > 0 Then AltName = mid(SuchText,Pos1)
If Pos1 > 0 Then DateiName = SuchText
Rem----------------------------------------------------------------
If DateiName = "" Then x = 1 : goto ende
x = 3
Rem ----------------------------------------------------------------
KurzName = DateiName
Datum = Format(Now(), "yymmdd")
lngNummer = 1
Datei = Pfad & Kurzname & Trenner & Datum & Trenner & lngNummer & DateiZusatz
if fileexists(datei) then
antwort = MsgBox ("Das aktive Dokument ( " & DateiName & " ) wurde bereits " & _
"gespeichert. " & chr(13) & chr(13) & "Wollen Sie es " & _
"erneut unter Angabe des Datums speichern?" & _
chr(13) & chr(13) & chr(13) & "Wenn nein, dann abbrechen." & chr(13) & " ", 1 , Titel )
if antwort = 2 then x = 2 : goto ende
rem------------------------------------------------------------------------------------------------------
Dateiname = PFAD2 & DateiName & TRENNER & Datum & TRENNER
lngNummer = 1
rem-----------------------------------------------------------------------------------------------------
for i = 1 to lngAnzahl ' Prüfen ob Datei existiert
Datei = Pfad & KurzName & trenner & Datum & Trenner & lngNummer & dateizusatz
If FileExists(Datei) Then
lngNummer = lngNummer + 1
else
exist = 0
End if
if exist = 0 then exit for
next i
rem ----------------------------------------------------------------------------------------------------
ende:
If x = 1 Then Mldg = "Dateiname fehlt ! Dokument nicht gespeichert !": _
Antwort = MsgBox(Mldg, 0 , Titel): end
If x = 2 Then Mldg = "Dokument nicht gespeichert !": _
Antwort = MsgBox(Mldg, 0 , Titel) : end
End If
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
Datei = "file:///" & Pfad2 & KurzName & Trenner & Datum & Trenner & lngNummer & dateizusatz
rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = Datei
args1(1).Name = "FilterName"
args1(1).Value = "writer8"
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
End Sub
_________________
Moderation: Zur übersichtlichen Darstellung des Textes und vom Programmcode im Text [code][/code] Tags gesetzt. – lorbass, Moderator
Hallo F3K Total
Du hast ja recht. Ich dachte, in bin im openoffice-forum.de. Darum wurde Remo nicht angenommen. Ich habe da die Foren durch-
einander gebracht. Hier lautet mein Name auch Remo, nur Rückwärts.
Es hat zwar sehr lange gedauert, aber ich habe das Makro dann doch noch hinbekommen. Sicher umständlich, aber es funktioniert.
Ich kann nun Briefe automatisch mit Dateiname + Datum + laufende Nummer abspeichern.
Du kannst es Dir ja mal anschauen. Vielleicht gefällt es Dir.
[code]Sub MitDatumSpeichern()
Pfad = "W:\Eigene Dateien\OpenOffice\"
Pfad2 = "W:/Eigene%20Dateien/OpenOffice/"
Trenner = "_"
DateiZusatz = ".odt"
lngAnzahl = 200 ' Anzahl der laufenden Nummern
Exist = 5
rem -------------------------------------------------------------
SuchText = thiscomponent.title ' Datei ohne datum feststellen
OrgDatei = SuchText
SuchZeichen = "_" ' Altname bis "_" feststellen
Pos1 = Instr(SuchText,SuchZeichen)
If Pos1 > 0 Then AltName = Left(SuchText,Pos1-1)
If Pos1 > 0 Then DateiName = SuchText
Voreinstellung = AltName
Mldg = "Dateiname OHNE Datum eingeben !"
Titel = "Datei speichern"
DateiName = InputBox(Mldg, Titel, Voreinstellung)
If DateiName = "" then x = 2 : goto ende
Rem----------------------------------------------------------------
SuchText = Dateiname ' evtl, "_" entfernen
SuchZeichen = "_"
Pos1 = Instr(SuchText,SuchZeichen)
If Pos1 > 0 Then AltName = mid(SuchText,Pos1)
If Pos1 > 0 Then DateiName = SuchText
Rem----------------------------------------------------------------
If DateiName = "" Then x = 1 : goto ende
x = 3
Rem ----------------------------------------------------------------
KurzName = DateiName
Datum = Format(Now(), "yymmdd")
lngNummer = 1
Datei = Pfad & Kurzname & Trenner & Datum & Trenner & lngNummer & DateiZusatz
if fileexists(datei) then
antwort = MsgBox ("Das aktive Dokument ( " & DateiName & " ) wurde bereits " & _
"gespeichert. " & chr(13) & chr(13) & "Wollen Sie es " & _
"erneut unter Angabe des Datums speichern?" & _
chr(13) & chr(13) & chr(13) & "Wenn nein, dann abbrechen." & chr(13) & " ", 1 , Titel )
if antwort = 2 then x = 2 : goto ende
rem------------------------------------------------------------------------------------------------------
Dateiname = PFAD2 & DateiName & TRENNER & Datum & TRENNER
lngNummer = 1
rem-----------------------------------------------------------------------------------------------------
for i = 1 to lngAnzahl ' Prüfen ob Datei existiert
Datei = Pfad & KurzName & trenner & Datum & Trenner & lngNummer & dateizusatz
If FileExists(Datei) Then
lngNummer = lngNummer + 1
else
exist = 0
End if
if exist = 0 then exit for
next i
rem ----------------------------------------------------------------------------------------------------
ende:
If x = 1 Then Mldg = "Dateiname fehlt ! Dokument nicht gespeichert !": _
Antwort = MsgBox(Mldg, 0 , Titel): end
If x = 2 Then Mldg = "Dokument nicht gespeichert !": _
Antwort = MsgBox(Mldg, 0 , Titel) : end
End If
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
Datei = "file:///" & Pfad2 & KurzName & Trenner & Datum & Trenner & lngNummer & dateizusatz
rem ----------------------------------------------------------------------
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = Datei
args1(1).Name = "FilterName"
args1(1).Value = "writer8"
dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())
End Sub[/code]
[color=#00AA00]_________________[/color]
[size=85][color=#00AA00][b]Moderation:[/b] Zur übersichtlichen Darstellung des Textes und vom Programmcode im Text [code][/code] Tags gesetzt. – lorbass, Moderator
[/color][/size]