office-explorer
Goto Top

Word2003Makro Dokument automatisch in neuem Unterordner speichern und ausdrucken

Hallo,

bin neu hier im Forum und "Laie" im VBA Programmieren. Es wäre nett, wenn mich jemand unterstützen könnte, die noch offenen Fragen zu klären.
Vielen Dank schon einmal im Voraus.

Wir sind eine Beratungsstelle, in der wir Gesprächsprotokolle mit Word2003 erstellen, die in zwei Versionen auf einem Serverlaufwerk abgespeichert werden sollen (1. Verlauf, 2. mit Anhang persönliche Notizen). Dies habe ich versucht über Makros in Word 2003 zu lösen.
Im ersten Makro wird das Worddokument, nach Abfrage des Speicheror-tes und –Namens abgespeichert. Dann wird ein Teil des Textes kopiert und unten angehängt, so dass man seine persönlichen Notizen anhängen kann. Dieses erste Makro (s. Anhang) funktioniert gut, bis darauf, dass der zuerst vorgeschlagene Speicherort nicht der jeweilige Desktop des jeweils angemeldeten Benutzers ist.

_________________________________________________
Sub PersönlichesProtokoll()
'
' PersönlichesProtokoll Makro
' Makro aufgezeichnet am 06.02.2013 von T.Mueller
'
Dim dialog As Object
Dim pfad As String
Dim datei As String
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll"
Set dialog = Application.FileDialog(msoFileDialogSaveAs)
With dialog
.InitialFileName = pfad
.Show
End With
If dialog <> False Then dialog.Execute
Selection.InsertBreak Type:=wdPageBreak
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
Selection.Copy
Selection.EndKey Unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeText Text:="Persönliche Notizen:"
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=21, Extend:=wdExtend
Selection.Font.Bold = wdToggle
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpace1pt5
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = True
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.AutoAdjustRightIndent = True
.DisableLineHeightGrid = False
.FarEastLineBreakControl = True
.WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False
.AddSpaceBetweenFarEastAndAlpha = True
.AddSpaceBetweenFarEastAndDigit = True
.BaseLineAlignment = wdBaselineAlignAuto
End With
Selection.MoveDown Unit:=wdLine, Count:=1
End Sub
_________________________________________________

Im zweiten Makro soll nun die Datei erneut abgespeichert werden und anschließend in ganzer Länge ausgedruckt werden. Auch das habe ich per Makro hinbekommen. Jetzt aber die Besonderheiten:
Der Dateiname soll gleich bleiben, aber in einem neu zu erstellenden Un-terordner, mit dem pauschalen Namen "PN" (für persönliche Notizen), in-nerhalb des bestehenden Ordners, abgespeichert werden. Zum Teil be-steht der PN Ordner schon (wenn zuvor Protokolle erstellt wurden), zum Teil auch nicht (erstes Protokoll). Der Ordner PN sollte also nur dann erstellt werden, wenn er noch nicht besteht. Nach dem Abspeichern soll die ge-samte Datei automatisch ausgedruckt werden.
Meine Schwierigkeit besteht nun darin, erstens den bestehenden Pfad zum Abspeichern auszulesen, zweitens zu sondieren, ob ein PN Ordner be-steht, drittens, diesen bei Bedarf einzufügen und dann die Datei dort ab-zuspeichern. Zudem hat sich beim Probieren oftmals gezeigt, dass im zwei-ten Makro beim Abspeichern als „Speicherort“ die Dokumentvorlagenauswahl angezeigt wurde und nicht die Ordnerstruktur für die Protokolle.

_________________________________________________
Sub ProtokollAusdrucken()
'
' ProtokollAusdrucken Makro
' Makro erstellt am 26.02.2013 von T.Mueller
'
Dim dialog As Object
Dim pfad As String
Dim datei As String
dname = ActiveDocument.Name
MsgBox (dname)
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll"
Set dialog = Application.FileDialog(msoFileDialogSaveAs)
With dialog
.InitialFileName = pfad
.Show
End With
Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End Sub

_________________________________________________

Soweit die Beschreibung des Problems. Kann jemand weiterhelfen und mir zeigen, wie ich die Makros programmieren kann. Vielen Dank schon ein-mal im Voraus.

Content-Key: 202786

Url: https://administrator.de/contentid/202786

Ausgedruckt am: 29.03.2024 um 09:03 Uhr

Mitglied: colinardo
colinardo 05.03.2013 aktualisiert um 10:38:46 Uhr
Goto Top
Hi Office-Explorer, Willkommen im Forum,

Zu deinem ersten Problem:
Zitat von @Office-Explorer:
Dieses erste Makro (s.
Anhang) funktioniert gut, bis darauf, dass der zuerst vorgeschlagene Speicherort nicht der jeweilige Desktop des jeweils
angemeldeten Benutzers ist.
Dein Pfad zu einem Ordner sollte mit einem Backslash(\} enden dann sollte der Dialog den Ordner richtig übernehmen.
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll\"  

Für dein zweites Problem sollte dir folgender Code weiterhelfen:
'Pfad des aktuellen Dokuments  
mainfolder = ActiveDocument.Path
'Pfad zum Subfolder "PN"  
pnSubFolder = mainfolder & "\PN"  
If Dir(subfolder, vbDirectory) <> vbNullString Then
   'Ordner PN existiert  
Else
   'Ordner PN existiert noch nicht, also erstelle Ihn  
   MkDir (subfolder)
End If

p.s. Bitte poste deinen Code der Übersicht halber mit Code-Tags, Danke.
Formatierungen in den Beiträgen

Grüße Uwe
Mitglied: Office-Explorer
Office-Explorer 05.03.2013 um 10:58:24 Uhr
Goto Top
Hallo Colinardo,

Danke für die schnelle Antwort. Ich werde es mal ausprobieren. Beim Posten habe ich schon nach der Formatierung gesucht und werde es beim nächsten mal machen. Leider kann ich heute nicht mehr an der Vorlage arbeiten, melde mich aber wieder, - hoffentlich mit Erfolg.

Grüße
Thomas
Mitglied: Office-Explorer
Office-Explorer 06.03.2013 um 17:34:22 Uhr
Goto Top
Hallo nochmals,

danke für die schnelle Antwort. Ich habe verschiedene Varianten die Befehlszeilen einzufügen, ausprobiert. Leider fehlt mir hier das Fachwissen und ich komme nicht weiter. Könnte mir jemand sagen, wie die einzelnen Befehlzeilen an die richtige Stelle gesetzt werden? Ziel: Dateiname beibehalten, Unterordner 'PN' erstellen, wenn nicht vorhanden, ansonsten darin abspeichern. Nachfolgend Dokument ausdrucken, aber das klappt ja, so dass ich das einfach hinten anhängen würde. Zur Übersicht nochmals mein Code.

Vielen Dank an Colinardo und all' die anderen fleißigen Helfer,

Thomas

 Sub ProtokollAusdrucken()
'  
' ProtokollAusdrucken Makro  
' Makro erstellt am 26.02.2013 von T.Mueller  
'  
Dim dialog As Object
Dim pfad As String
Dim datei As String
    dname = ActiveDocument.Name
    MsgBox (dname)
pfad = "B:\8. FALL - VERWALTUNG\5. LAUFENDE FÄLLE\Gesprächsprotokoll"  
Set dialog = Application.FileDialog(msoFileDialogSaveAs)
With dialog
.InitialFileName = pfad
.Show
End With
        Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _  
        wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _  
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
End Sub
Mitglied: colinardo
colinardo 06.03.2013 um 20:36:02 Uhr
Goto Top
 Sub ProtokollAusdrucken()

Dim dialog As Object
Dim pfad As String
Dim datei As String
dname = ActiveDocument.Name

'Pfad des aktuellen Dokuments  
mainfolder = ActiveDocument.Path
'Pfad zum Subfolder "PN"  
pnSubFolder = mainfolder & "\PN"  
If Dir(pnSubFolder, vbDirectory) = vbNullString Then
   MkDir (pnSubFolder)
End If
ActiveDocument.SaveAs2 FileName:=pnSubFolder & "\" & dname  

        Application.PrintOut Filename:="", Range:=wdPrintAllDocument, Item:= _  
        wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _  
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
End Sub
Mitglied: Office-Explorer
Office-Explorer 07.03.2013 um 10:22:26 Uhr
Goto Top
Hallo Colinardo,

nochmals Danke für dein Bemühen. Es klappt alles Bestens. Eine tiefe Verbeugung für soviel Unterstützung,

Thomas
Mitglied: colinardo
colinardo 07.03.2013 um 10:24:19 Uhr
Goto Top
Keine Ursache...
Bitte Beitrag noch als gelöst markieren. Danke.

Grüße Uwe