Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Einzelne Seiten aus Word einzeln Abspeichern

Frage Microsoft Microsoft Office

Mitglied: geocast

geocast (Level 1) - Jetzt verbinden

07.11.2013 um 11:24 Uhr, 4333 Aufrufe, 5 Kommentare

Hallo zusammen

Ich habe hier ein Word Dokument das durch Crystal Reports erstellt wird. Es enthält mehrere Seiten.

Jetzt möchte ich die einzelnen Seiten einzeln Abspeichern.

Das Problem ist, manche Dokumente darin enthalten beliebig viele Seiten, also eines kann eine Seite sein, währen ein anderes 5 hat. Sehen kann man es in der Fußzeile, Seite 1 von x.

Gibt es ein Programm, das dies erkennen kann und mir dann dementsprechend abspeichert? Ein Script ist auch in Ordnung.

Vielen Dank
Mitglied: colinardo
07.11.2013, aktualisiert um 17:22 Uhr
Hallo geocast,
das könntest du mit diesem VB-Script erreichen welches alle Word-Dokumente in einem Verzeichnis verarbeitet und die Seiten jeweils als separates Dokument in einem Ordner deiner Wahl speichert:
Bitte noch folgende Variablen an dein System anpassen:
  • Zeile 2: Pfad in dem die Dokumente liegen
  • Zeile 4: Ordner in dem die einzelnen Seiten als Dokumente abgelegt werden
  • Zeile 6: Pfad zu einer Log-Datei die erstellt wird (falls Fehler auftreten)
  • Zeile 8: (Optional) Hier werden die Erweiterungen der Dateien angegeben die im Quellordner verarbeitet werden sollen.
01.
'Pfad zu den Dokumenten 
02.
Const strPathDocs = "C:\temp\docs" 
03.
'ZielOrdner für die gesplitteten Dateien 
04.
Const strAusgabeOrdner = "c:\temp\docs\ausgabe" 
05.
'Logfile für eventuell auftretende Fehler 
06.
Const strPathLogfile = "c:\temp\docs\logfile.txt" 
07.
'Erweiterungen der Dateien die bearbeitet werden sollen 
08.
arrFileExtensions = Array("doc","docx") 
09.
 
10.
Set fso = Wscript.CreateObject("Scripting.Filesystemobject") 
11.
Set objWord = WScript.CreateObject("Word.Application") 
12.
Set objShell = CreateObject("Wscript.Shell") 
13.
Dim intDocCount, intErrCount 
14.
'Applikation anzeigen und eventuelle Dialoge für Batchbetrieb unterdrücken 
15.
objWord.Visible = True 
16.
objWord.DisplayAlerts = -1 
17.
objWord.ScreenUpdating = False 
18.
'Im Ordner alle Word-Dokumente verarbeiten 
19.
parseFolders fso.GetFolder(strPathDocs), False 
20.
'Das Anzeigen von Benachrichtigungen wieder aktivieren und Word schließen 
21.
objWord.DisplayAlerts = -1 
22.
objWord.ScreenUpdating = True 
23.
objWord.Quit True 
24.
Set fso = Nothing 
25.
Set objWord = Nothing 
26.
If intErrCount = 0 Then 
27.
	MsgBox "Es wurden insgesamt " & intDocCount & " Dokument(e) verarbeitet.", vbInformation, "Verarbeitung abgeschlossen" 
28.
Else 
29.
	MsgBox "Es wurden insgesamt " & intDocCount & " Dokumente verarbeitet." & vbCrLf & "Davon ist bei " & intErrCount & " Dokument(en) ein Fehler aufgetreten!", vbInformation, "Verarbeitung abgeschlossen" 
30.
	objShell.Run "Notepad.exe " & strPathLogfile 
31.
End If 
32.
 
33.
'Ende 
34.
 
35.
Function parseFolders(fldr, boolRecursion) 
36.
    For Each file In fldr.Files 
37.
    	For i = 0 To UBound(arrFileExtensions) 
38.
			If LCase(arrFileExtensions(i)) = LCase(fso.GetExtensionName(file.Path)) Then 
39.
				intDocCount = intDocCount + 1  
40.
	            'Fehlerbehandlung für den Fall das ein Fehler beim Öffnen eines Dokumentes auftritt 
41.
	            On Error Resume Next 
42.
	            Set objDoc = objWord.Documents.Open(file.Path) 
43.
	            If Err.Number <> 0 Then 
44.
	            	intErrCount = intErrCount + 1 
45.
	            	WriteLog "!!ERROR!! Fehler beim öffnen der Datei: -> '" & file.Path & "'" 
46.
	            Else 
47.
	            	sBasename = fso.GetBaseName(file.Path) 
48.
				    sExtension = fso.GetExtensionName(file.Path) 
49.
				    sPath = fso.GetParentFolderName(file.Path) 
50.
				    If Not fso.FolderExists(strAusgabeOrdner) Then 
51.
				    	fso.CreateFolder(strAusgabeOrdner) 
52.
				    End If 
53.
	            	Set rngPage = objDoc.Range 
54.
	            	iCurrentPage = 1 
55.
	            	iPageCount = objDoc.Content.ComputeStatistics(2) 
56.
	             
57.
	            	Do Until iCurrentPage > iPageCount 
58.
				        If iCurrentPage = iPageCount Then 
59.
				            rngPage.End = objDoc.Range.End 
60.
				        Else 
61.
				            objWord.Selection.GoTo 1, 1, (iCurrentPage + 1) 
62.
				            rngPage.End = objWord.Selection.Start 
63.
				        End If 
64.
				        rngPage.Copy 
65.
				        Set docSingle = objWord.Documents.Add 
66.
				        docSingle.Range.Paste 
67.
				        docSingle.Range.Find.Execute "^m",,,,,,,,,"" 
68.
				        strNewFileName = strAusgabeOrdner & "\" & sBasename & "_" & iCurrentPage & "." & sExtension 
69.
				        docSingle.SaveAs strNewFileName 
70.
				        iCurrentPage = iCurrentPage + 1 
71.
				        docSingle.Close 
72.
        				rngPage.Collapse 0 
73.
    				Loop 
74.
	            	 
75.
	            	objDoc.Close False 
76.
	            	WriteLog "Dokument wurde verarbeitet: ->'" & file.Path & "'" 
77.
	            End if 
78.
	            Exit For 
79.
	         End If 
80.
		Next 
81.
    Next 
82.
     
83.
    'Funktion wird rekursiv aufrufen wenn das durchsuchen aller Unterordner gewünscht ist 
84.
    If boolRecursion Then 
85.
		For Each subFolder in fldr.SubFolders 
86.
			parseFolders subFolder, True 
87.
		Next 
88.
	End If 
89.
End Function 
90.
 
91.
Function WriteLog(strText) 
92.
	Set objLog = fso.OpenTextFile(strPathLogfile,8,True) 
93.
	logline = Now & " - " & strText 
94.
	objLog.WriteLine(logline) 
95.
	objLog.Close 
96.
End Function
Grüße Uwe
Bitte warten ..
Mitglied: geocast
08.11.2013 um 08:39 Uhr
Hallo Uwe

Danke für dein Script. Allerdings funktioniert das nicht ganz so. Es unterteilt jede Seite in ein einzelnes Dokument. Ich bräuchte allerdings eines, dass erkennt, welche Seiten zusammen gehören und die in ein Dokument abspeichert.

Danke trotzdem
Bitte warten ..
Mitglied: colinardo
08.11.2013 um 09:04 Uhr
D.h die Dokumente haben mehrere Abschnitte im Dokument ? z.B nummeriert 1-5 , 1-3, etc ?

Dazu müsstest du mir mal ein Demodokument via PM(personal message) zuschicken, es reicht wenn die Fusszeilen original bleiben den Rest kannst du ja rauslöschen. Dann kann ich das Script eventuell an deine Bedürfnisse Anpassen ...

Grüße Uwe
Bitte warten ..
Mitglied: colinardo
08.11.2013, aktualisiert um 11:52 Uhr
Nach der Analyse eines der Dokumente sind wir letztendlich zu folgendem Script gekommen, welches den Inhalt jeder Seite auf das vorkommen des Strings "Seite X von X" in allen Textframes hin untersucht und anhand dessen die Seiten-Sektionen unterteilt und jeweils ein Dokument daraus generiert.
Bitte beachten das das folgende Script doch sehr spezifisch angepasst ist, und nicht universell verwendet werden kann, da es sich nicht an die in Word vorhandenen Funktionen zum Aufteilen mit Abschnitten hält, weil eben die Quelldokumente nicht so formatiert waren.
01.
'Pfad zu den Dokumenten 
02.
Const strPathDocs = "C:\temp\docs" 
03.
'ZielOrdner für die gesplitteten Dateien 
04.
Const strAusgabeOrdner = "c:\temp\docs\ausgabe" 
05.
'Logfile für eventuell auftretende Fehler 
06.
Const strPathLogfile = "c:\temp\docs\logfile.txt" 
07.
'Erweiterungen der Dateien die bearbeitet werden sollen 
08.
arrFileExtensions = Array("doc","docx") 
09.
 
10.
Set fso = Wscript.CreateObject("Scripting.Filesystemobject") 
11.
Set objWord = WScript.CreateObject("Word.Application") 
12.
Set objShell = CreateObject("Wscript.Shell") 
13.
Set regex = CreateObject("vbscript.regexp") 
14.
regex.Pattern = "Seite (\d+) / (\d+)" 
15.
Dim intDocCount, intErrCount 
16.
'Applikation anzeigen und eventuelle Dialoge für Batchbetrieb unterdrücken 
17.
objWord.Visible = True 
18.
objWord.DisplayAlerts = -1 
19.
objWord.ScreenUpdating = False 
20.
'Im Ordner alle Word-Dokumente verarbeiten 
21.
parseFolders fso.GetFolder(strPathDocs), False 
22.
'Das Anzeigen von Benachrichtigungen wieder aktivieren und Word schließen 
23.
objWord.DisplayAlerts = -1 
24.
objWord.ScreenUpdating = True 
25.
objWord.Quit True 
26.
Set fso = Nothing 
27.
Set objWord = Nothing 
28.
Set regex = Nothing 
29.
If intErrCount = 0 Then 
30.
	MsgBox "Es wurden insgesamt " & intDocCount & " Dokumente verarbeitet.", vbInformation, "Verarbeitung abgeschlossen" 
31.
Else 
32.
	MsgBox "Es wurden insgesamt " & intDocCount & " Dokumente verarbeitet." & vbCrLf & "Davon ist bei " & intErrCount & " Dokumenten ein Fehler aufgetreten!", vbInformation, "Verarbeitung abgeschlossen" 
33.
	objShell.Run "Notepad.exe " & strPathLogfile 
34.
End If 
35.
 
36.
'Ende 
37.
 
38.
Function parseFolders(fldr, boolRecursion) 
39.
    For Each file In fldr.Files 
40.
    	For i = 0 To UBound(arrFileExtensions) 
41.
			If LCase(arrFileExtensions(i)) = LCase(fso.GetExtensionName(file.Path)) Then 
42.
				intDocCount = intDocCount + 1  
43.
	            'Fehlerbehandlung für den Fall das ein Fehler beim Öffnen eines Dokumentes auftritt 
44.
	            On Error Resume Next 
45.
	            Set objDoc = objWord.Documents.Open(file.Path) 
46.
	            If Err.Number <> 0 Then 
47.
	            	intErrCount = intErrCount + 1 
48.
	            	WriteLog "!!ERROR!! Fehler beim öffnen der Datei: -> '" & file.Path & "'" 
49.
	            Else 
50.
	            	sBasename = fso.GetBaseName(file.Path) 
51.
				    sExtension = fso.GetExtensionName(file.Path) 
52.
				    sPath = fso.GetParentFolderName(file.Path) 
53.
				    If Not fso.FolderExists(strAusgabeOrdner) Then 
54.
				    	fso.CreateFolder(strAusgabeOrdner) 
55.
				    End If 
56.
	            	Set rngPage = objDoc.Range 
57.
	            	iCurrentPage = 1 
58.
	            	iSubDocCount = 1 
59.
	            	iPageCount = objDoc.Content.ComputeStatistics(2) 
60.
	            	 
61.
	            	Do Until iCurrentPage > iPageCount 
62.
				        For Each frame In rngPage.Frames 
63.
				            Set myMatches = regex.Execute(frame.Range.Text) 
64.
				            If myMatches.Count >= 1 Then 
65.
				                Set myMatch = myMatches(0) 
66.
				                If myMatch.SubMatches.Count >= 1 Then 
67.
				                    sectionpage = myMatch.SubMatches(0) 
68.
				                    sectioncount = myMatch.SubMatches(1) 
69.
				                    If sectionpage = sectioncount Then 
70.
				                        If iCurrentPage = iPageCount Then 
71.
				                            rngPage.End = objDoc.Range.End  
72.
				                        Else 
73.
				                            objWord.Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1 
74.
				                            rngPage.End = objWord.Selection.Start 
75.
				                        End If 
76.
				                        rngPage.Copy 
77.
				                        Set docSingle = objWord.Documents.Add 
78.
				                        docSingle.Range.Paste 
79.
				                        If sectioncount = 1 Then 
80.
				                            docSingle.Range.Find.Execute "^m",,,,,,,,,"" 
81.
				                            docSingle.Range.Find.Execute "^b",,,,,,,,,"" 
82.
				                        End If 
83.
				                        strNewFileName = strAusgabeOrdner & "\" & sBasename & "_" & iSubDocCount & "." & sExtension 
84.
				                        docSingle.SaveAs strNewFileName 
85.
				                        iCurrentPage = iCurrentPage + 1 
86.
				                        iSubDocCount = iSubDocCount + 1 
87.
				                        docSingle.Close 
88.
				                        rngPage.Collapse 0 
89.
				                    Else 
90.
				                        objWord.Selection.GoTo 1, 1, iCurrentPage + 1 
91.
				                        iCurrentPage = iCurrentPage + 1 
92.
				                        rngPage.Collapse 0 
93.
				                    End If 
94.
				                End If 
95.
				            End If 
96.
				        Next 
97.
				    Loop 
98.
	            	objDoc.Close False 
99.
	            	WriteLog "Dokument wurde verarbeitet: ->'" & file.Path & "'" 
100.
	            End if 
101.
	            Exit For 
102.
	         End If 
103.
		Next 
104.
    Next 
105.
     
106.
    'Funktion wird rekursiv aufrufen wenn das durchsuchen aller Unterordner gewünscht ist 
107.
    If boolRecursion Then 
108.
		For Each subFolder in fldr.SubFolders 
109.
			parseFolders subFolder, True 
110.
		Next 
111.
	End If 
112.
End Function 
113.
 
114.
Function WriteLog(strText) 
115.
	Set objLog = fso.OpenTextFile(strPathLogfile,8,True) 
116.
	logline = Now & " - " & strText 
117.
	objLog.WriteLine(logline) 
118.
	objLog.Close 
119.
End Function
Grüße Uwe
Bitte warten ..
Mitglied: colinardo
09.11.2013 um 10:28 Uhr
Wenns das dann war, Beitrag bitte noch als gelöst markieren. Merci.
Grüße Uwe
Bitte warten ..
Neuester Wissensbeitrag
Internet

Unbemerkt - Telekom Netzumschaltung! - BNG - Broadband Network Gateway

(3)

Erfahrungsbericht von ashnod zum Thema Internet ...

Ähnliche Inhalte
Heiß diskutierte Inhalte
Switche und Hubs
Trunk für 2xCisco Switch. Wo liegt der Fehler? (15)

Frage von JayyyH zum Thema Switche und Hubs ...

DSL, VDSL
DSL-Signal bewerten (13)

Frage von SarekHL zum Thema DSL, VDSL ...