Hallo vielleicht kann mir irgendjemand helfen. Ich habe eine Worddatei
mit 610 Seiten die getrennt werden sollen. Dazu habe ich schon ein
nützliches Makro:

[.vb]

Public Sub JedeSeiteInNeuesDokument()
Dim wdDoc As Document
Dim wdDocNeu As Document
Dim wdBereich As Range

Dim sPfad As String
Dim optAnsicht As Long

Dim iSeitenAnz As Integer
Dim i As Integer
Dim iDocNum As Integer

'Verweis auf Dokument setzen:
Set wdDoc = ActiveDocument

'Speicher-Pfad für neue Dokumente:
'Es wird vorausgesetzt, dass das aktive Dokument gespeichert ist
sPfad = wdDoc.Path & "\" & "Test_"

'Bildschirmaktualisierung deaktivieren (Flackern wird zumindest vermindert)
Application.ScreenUpdating = False

'Einstellung Seiten-Ansicht sichern:
'optAnsicht = wdDoc.ActiveWindow.View.Type
optAnsicht = Windows(wdDoc).View.Type

'Seiten-Ansicht SeitenLayout einstellen:
Windows(wdDoc).View.Type = wdPageView

'Cursor zum Anfang des Dokuments:
wdDoc.Range(0, 0).Select

'Browser-Eigenschaft einstellen, hier: "Nach Seite durchsuchen"
'Gibt ein Browser-Objekt zurück, das die Schaltfläche "Objekt für
'Durchsuchen markieren" auf der vertikalen Bildlaufleiste darstellt
Application.Browser.Target = wdBrowsePage

'Dokument-Nr. zum Speichern - Startwert setzen
iDocNum = 0

'Anzahl Seiten im Dokument ermitteln
iSeitenAnz = wdDoc.ComputeStatistics(wdStatisticPages)

For i = 1 To iSeitenAnz
'Verweis auf den zu kopierenden Bereich setzen
Set wdBereich = wdDoc.Bookmarks("\Page").Range

'Den zu kopierenden Bereich überprüfen, ob Seitenwechsel dabei ist;
'ggf. den Bereich verkleinern
If Right(wdBereich.Text, 1) = Chr(12) Then
wdBereich.SetRange Start:=wdBereich.Start, End:=wdBereich.End - 1
End If

'Neues Dokument öffnen, auf Basis derselben Dokumentvorlage
'wie das Original-Dokument
Set wdDocNeu = Documents.Add _
(Template:=wdDoc.AttachedTemplate.FullName)
'oder auf Basis der Normal.dot:
'Set wdDocNeu = Documents.Add

'Formatierten Text -> neue Datei
wdDocNeu.Content.FormattedText = wdBereich.FormattedText

'Dokument-Nr. zum Speichern erhöhen
iDocNum = iDocNum + 1

'Neues Dokument speichern:
wdDocNeu.SaveAs FileName:=sPfad & Format(iDocNum, "000")

'Neues Dokument schließen
wdDocNeu.Close

'Dokument aktivieren
wdDoc.Activate

'Zur nächsten Seite im Original-Dokument wechseln
Application.Browser.Next
Next i

'Ursprüngliche Seiten-Ansicht wieder einstellen
Windows(wdDoc).View.Type = optAnsicht

'Cursor zum Anfang des Dokuments
wdDoc.Range(0, 0).Select

'Bildschirmaktualisierung aktivieren
Application.ScreenUpdating = True

'Verweise freigeben
Set wdBereich = Nothing
Set wdDocNeu = Nothing
Set wdDoc = Nothing
End Sub

[./vb]


Leider habe ich dann eine fortlaufende Nummerierung und ich möchte die
Spalte "B" die "Name" heißt als Deteinamen einfügen und zusätzlich noch
das Suffix .txt oder oder direkt dateiname.html.txt damit ich nur das
txt entfernen muss. Das müsste per Array funktionieren. Am Anfang müssen
irgendwie die ganzen Dateinamen aus der Excel-Datei in ein Array
einlesen werden und beim Namen für das Speichern den Array Index
parallel zu den Seiten hoch zählen und so den gesamten Dateinamen
zusammenbasteln. Also bei Seite 1 array(1)+".txt" bei der zweiten Seite
dann array(2)+"txt" und so weiter. als Array Index natürlich eine
Variable nehmen. Aber ich bin mir nicht sicher wo das in meinen Code
reingehört. Kann mir irgendjemand helfen. Vielen Dank





Hier ist eventuell der Code der die Lösung enthält. Bin mir jedoch nicht sicher.


[.vb]

Option Explicit

Sub DateienNamenLesen()

Dim DateiPath As String

Dim DateiEndung As String

Dim DateiName As String

Dim DateiNamen() As String

Dim ArrIndex As Integer

DateiPath = "C:\temp\"

DateiEndung = "*.xls"

ArrIndex = 1

ReDim Preserve DateiNamen(ArrIndex)

DateiName = Dir(DateiPath & DateiEndung)

Do While DateiName <> ""

ArrIndex = ArrIndex + 1

ReDim Preserve DateiNamen(ArrIndex)

DateiNamen(ArrIndex) = DateiName

DateiName = Dir

Loop

End Sub

[./vb]


Sorry @ MarcoIT...Ich habe es geändert

Kannst du bitte das VB-Tag verwenden?
[.vb]Dein Code [./vb]