Top-Themen

Aktuelle Themen (A bis Z)

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

Mitglied: geocast

geocast (Level 2) - Jetzt verbinden

07.11.2013 um 11:24 Uhr, 6502 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 ..
Ähnliche Inhalte
Windows Server

Gruppenrichtlinienvererberung einzeln deaktivieren

gelöst Frage von xbast1xWindows Server4 Kommentare

Hallo zusammen, ich habe eine Haupt OU mit einer Sub OU. Die Sub OU bekommt die GPO von der ...

Schulung & Training

Ct einzeln als PDF?

gelöst Frage von honeybeeSchulung & Training2 Kommentare

Hallo, vielleicht bin ich einfach zu doof, aber gibt es die derzeit aktuelle c't nicht mehr als PDF? Ich ...

Outlook & Mail

Kalendereinträge einzeln filtern und exportieren

Frage von GraudonOutlook & Mail4 Kommentare

Hallo zusammen, ich suche eine Möglichkeit, Kalendereinträge nach bestimmten Kriterien (z.B. Name, Kategorie, Url) zu filtern und dann in ...

LAN, WAN, Wireless

ESXi-Server NIC Trunking vs. Einzeln

Frage von killtecLAN, WAN, Wireless33 Kommentare

Hallo, wir haben bei uns mehrere Server (ESXi) wo jeweils die einzelnen NICS separat auf den Switch gehen. Ich ...

Neue Wissensbeiträge
Backup

Veeam Agent für MS Windows - neue Version verfügbar (bedingt jedoch offenbar .NET Framework 4.6)

Information von VGem-e vor 9 StundenBackup

Moin Kollegen, einer unserer Server zeigte grad an, dass für o.g. Software ein Update verfügbar ist. Ob ein evtl. ...

Python

Sie meinen es ja nur gut - Microsoft hilft python-Entwicklern auf unnachahmliche Weise

Information von DerWoWusste vor 2 TagenPython2 Kommentare

Stellt Euch vor, Ihr nutzt python unter Windows 10 und skriptet damit regelmäßig Dinge. Nach dem Update auf Windows ...

Sicherheits-Tools

TrendMicro Worry-Free Business Security 10.0 SP1 steht in Englisch bereit mit Unterstützung für Windows 10 1903 (May Update)

Information von VGem-e vor 2 TagenSicherheits-Tools1 Kommentar

Moin Kollegen, Dann kommt wohl demnächst auch die deutschsprachige/europäische Version zur Auslieferung. Gruß VGem-e

Batch & Shell
PowerShell Konferenz - Videos online
Information von NetzwerkDude vor 2 TagenBatch & Shell

Abend, die Tage werden Videos der Talks von der diesjährigen EU Powershell Konferenz hochgeladen, sind einige Interessante dabei: MFG ...

Heiß diskutierte Inhalte
Google Android
Anbieter für Diensthandys
Frage von Pat.batGoogle Android21 Kommentare

Hallo zusammen, ich bin seit einiger Zeit zuständig für die Diensthandys bei uns in der Behörde. Eine Management Software ...

Microsoft Office
Office 365 eMail via Website verschicken
Frage von BiBeSoMicrosoft Office16 Kommentare

Hallo, kann man im Office 365 eMails anlegen welche zum versenden (smtp) für die Website funktionieren ? Muss man ...

Windows Server
Verbindunsproblem zwischen Klient und Wsus-Server
Frage von flashgordon78Windows Server16 Kommentare

Liebe Forum Besucher! Ich habe ein Wsus_Server (Win Server 2016) erstellt und die Update sind herunterladen worden. Aber ich ...

Exchange Server
Vorgehen um von Tobit auf Exchange zu wechseln
Frage von Martin1987Exchange Server15 Kommentare

Guten Abend Ich habe den Auftrag erhalten, unser Mail von David zu Outlook zu wechseln. Wie muss ich da ...