Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
944to948
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
944to948
944to948
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Alle Daten von PRN Dateien in eine TXT Datei

Alle Daten von PRN Dateien in eine TXT Datei
24.01.2008 12:32:28
PRN
Hallo alle zusammen,
Mit folgenden Makro lese ich alle prn Dateien einen Verzeichnisses in eine Datei Namens Alle.txt mit dem Namen der jeweiligen PRN Datei ein.
Mit Excel 2003 funktioniert es wunderbar aber nicht in 2007.
Ich habe die Zeile fett hinterlegt, wo das Makro hängen bleibt.

Sub PRNnachALLE()
'Erstellt unter Excel 2003
'Schreibt die Zeilen aller PRN-Dateien eines Verzeichnis in die Datei Alle.txt
Dim PfadPNR As String, PfadAktuell As String, Dummy, Datei
'Pfad der PNR-Dateien wählen
PfadAktuell = VBA.CurDir
Dummy = Application.GetOpenFilename(Filefilter:="PRN-Datei (*.PRN),*.PRN", Title:="Bitte PRN- _
Datei im Zielordner auswählen")
If Dummy = False Then Exit Sub
PfadPNR = VBA.CurDir
VBA.ChDir PfadAktuell
Open PfadPNR & "\Alle.txt" For Output As #1
 With Application.FileSearch  'hier hängt es bei Excel 2007
.LookIn = PfadPNR
.FileName = "*.PRN"
.Execute
'Daten aus Dateien nach Alle.txt schreiben
For Each Datei In .FoundFiles
Open Datei For Input As #2
Do Until EOF(2)
Line Input #2, Dummy
Print #1, Dummy
Loop
Close #2
'Dateinamen ohne Endung in Datei schreiben
Dummy = Right(Datei, Len(Datei) - InStrRev(Datei, "\"))
Print #1, Left(Dummy, Len(Dummy) - 4)
Next
End With
Close #1
End Sub


Kann mir bitte jemand helfen, dass es auch mit Excel 2007 funktioniert.
Vielen Dank im voraus!
MFG Andre

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Beispieldateien
24.01.2008 16:27:00
Andre´
Hallo alle zusammen,
ich habe mal ein paar Bsp. Dateien als txt angehängt weil prn Format nicht möglich ist hoch zu laden. Falls diese lokal gespeichert werden sollten dann die Endung auf prn abändern.
Die nachfolgenden 3 Dateien sind in einem Ordner.
https://www.herber.de/bbs/user/49339.txt
https://www.herber.de/bbs/user/49340.txt
https://www.herber.de/bbs/user/49341.txt
So sieht dann die Datei aus die ebenfalls im gleichen Ordner erstellt wird:
https://www.herber.de/bbs/user/49342.txt
MFG Andre

Anzeige
AW: Beispieldateien
24.01.2008 16:38:17
Josef
Hallo Andre´,
"FileSearch" wird in xl2007 nicht mehr uterstützt.
Das sollte funktionieren. (ungetestet!)
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub PRNnachALLE()
'Erstellt unter Excel 2003
'Schreibt die Zeilen aller PRN-Dateien eines Verzeichnis in die Datei Alle.txt
Dim PfadPNR As String, PfadAktuell As String, Dummy
Dim result As Long, l As Long, a

'Pfad der PNR-Dateien wählen
PfadAktuell = VBA.CurDir
Dummy = Application.GetOpenFilename(Filefilter:="PRN-Datei (*.PRN),*.PRN", _
    Title:="Bitte PRN-Datei im Zielordner auswählen")
If Dummy = False Then Exit Sub
PfadPNR = VBA.CurDir
VBA.ChDir PfadAktuell

Open PfadPNR & "\Alle.txt" For Output As #1

result = FileSearchFSO(a, PfadPNR, "*.PRN", True)

If result <> 0 Then
    For l = 0 To UBound(a)
        Open a(l) For Input As #2
        Do Until EOF(2)
            Line Input #2, Dummy
            Print #1, Dummy
        Loop
        Close #2
        'Dateinamen ohne Endung in Datei schreiben
        Dummy = Right(a(l), Len(a(l)) - InStrRev(a(l), "\"))
        Print #1, Left(Dummy, Len(Dummy) - 4)
    Next
End If

Close #1

End Sub

'by J.Ehrensberger
Private Function FileSearchFSO(ByRef Files As Variant, ByVal InitialPath As String, Optional ByVal FileName As String = "*", _
    Optional ByVal SubFolders As Boolean = False) As Long


Dim mobjFSO As Object, mfsoFolder As Object, mfsoSubFolder As Object, mfsoFile As Object

Set mobjFSO = CreateObject("Scripting.FileSystemObject")

Set mfsoFolder = mobjFSO.GetFolder(InitialPath)

On Error Resume Next

For Each mfsoFile In mfsoFolder.Files
    If Not mfsoFile Is Nothing Then
        If LCase(mobjFSO.GetFileName(mfsoFile)) Like LCase(FileName) Then
            If IsArray(Files) Then
                Redim Preserve Files(UBound(Files) + 1)
            Else
                Redim Files(0)
            End If
            Files(UBound(Files)) = mfsoFile
        End If
    End If
Next

If SubFolders Then
    For Each mfsoSubFolder In mfsoFolder.SubFolders
        FileSearchFSO Files, mfsoSubFolder, FileName, SubFolders
    Next
End If

If IsArray(Files) Then FileSearchFSO = UBound(Files) + 1
On Error GoTo 0
Set mobjFSO = Nothing
Set mfsoFolder = Nothing
End Function

Gruß Sepp

Anzeige
AW: Beispieldateien :-)))
24.01.2008 19:33:00
Andre´
Hallo Sepp,
Tausend DANK!!
Funktioniert prima auch unter 2003.
MFG Andre

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige