Dateiname aus Excel auslesen und als txt spechern
Sandy
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
Hier ist eventuell der Code der die Lösung enthält. Bin mir jedoch nicht sicher.
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