Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1440to1444
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
Inhaltsverzeichnis

Alle.txt-Datei aus einem Ordner importieren

Alle.txt-Datei aus einem Ordner importieren
19.08.2015 12:35:17
Basti
Servus Herber-Gemeinde,
leider bin ich erneut an meine VBA-Grenzen gestossen und benötige Eure Unterstützung.
Das Thema ist zwar schon 1000-mal diskutiert, leider komme ich mit meinen Copy & Paste-Fähigkeiten damit nicht zurecht.
Der u.a. Code liest "eine" ausgewählte .txt aus dem gewählten Ordner und importiert den Inhalt in Spalte A der aktuell geöffneten Tabelle.
Mein Ziel ist es, dass "alle" Dateien im Zielordner, die diese Format haben, in Spalten getrennt und mit dem Dateinamen als Überschrift in die aktuelle Mappe geschrieben werden.
Danke für Eure Hilfe
Gruß
Basti
Sub Datei_importieren()
Dim Datei As String, Text As String
Dim Zeile As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
On Error GoTo Fehler
'Quelldatei festlegen
Datei = Application.GetOpenFilename("Textdateien (*.txt), *.txt")
Open Datei For Input As #1         ' Quelldatei öffnen.
Zeile = 1
Do While Not EOF(1)           ' Schleife bis Dateiende
Line Input #1, Text      ' Text lesen
ActiveSheet.Cells(Zeile, 1) = Text
Zeile = Zeile + 1
Loop
Close #1   'Quelldatei schließen
Exit Sub
Fehler:
Close #1
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "da ist leider ein Fehler aufgetreten"
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alle.txt-Datei aus einem Ordner importieren
19.08.2015 13:35:52
Matthias
Hallo Basti,
Dir(Datei)
liefert dir die Datei die du mit GetOpenFile gewählt hast
Dir("*.*")
liefert dir die erste Datei in deinem mit GetOpenFile ermittelten Verzeichnis
Dir
(ohne Angabe von Elementen) wählt die nächste Datei im Verzeichnis
Wenn du weitere Hilfe benötigst, sag bescheid
lg Matthias

AW: Alle.txt-Datei aus einem Ordner importieren
19.08.2015 13:36:56
Matthias
Der Doppelpost tut mir leid, wiedermal zu ungeduldig.
lg Matthias

AW: Alle.txt-Datei aus einem Ordner importieren
19.08.2015 13:51:51
Matthias
Hier mal eine auf die für dich relaventen Basics gekürzte Variante eines Codes den ich mal verwendet habe:

Dim myFileAddress As Variant, myFileDirectory As String, myFile As String 'Adresse / Dateipfad / _
Dateiname
myFileAddress = Application.GetOpenFilename("CSV-Dateien *.csv,*.csv")
If myFileAddress = False Then Exit Sub
myFile = Dir("*.*") 'erste Datei im Ordner
myFileDirectory = CurDir(myFileAddress)
Do Until myFile = ""
myFileAddress = "TEXT;" & myFileDirectory & "\" & myFile
Call Open_File 'Datei importieren und im TB "Tmp" temporär ablegen
Call Copy_File  'Daten aus TB "Tmp" ausschneiden und im TB "Import-Daten" einfügen
myFile = Dir 'nächste Datei
Loop
Ich denke den Rest solltest du selber hinkriegen ;)
lg Matthias

Anzeige
AW: Alle.txt-Datei aus einem Ordner importieren
19.08.2015 15:32:18
Basti
Servus Matthias,
hast Du noch die Routine/Funktion für
Call Open_File 'Datei importieren und im TB "Tmp" temporär ablegen

&
Call Copy_File  'Daten aus TB "Tmp" ausschneiden und im TB "Import-Daten" einfügen

Ohne die funktioniert der Ablauf zumindestens nicht.
Gruß
Basti

AW: Alle.txt-Datei aus einem Ordner importieren
19.08.2015 16:04:55
Matthias
Sicher, ich bin nur davon ausgegangen, dass du das ganze mit deinen Aktionen ersetzt^^
Du verwendest ja auch eine Methode um die Mappe selber zu öffnen und nur bestimmte Elemente davon zu kopieren - nicht wie ich die komplette Datei zu importieren.
Statt Open_File würdest du folgende deiner Zeilen dort einfügen, wobei "Datei" mit "myFileAddress" ersetzt werden müsste:
(myFileAddress = myFileDirectory & "\" & myFile)

Open myFileAddress For Input As #1         ' Quelldatei öffnen.
Zeile = 1
Do While Not EOF(1)           ' Schleife bis Dateiende
Line Input #1, Text      ' Text lesen
ActiveSheet.Cells(Zeile, 1) = Text
Zeile = Zeile + 1
Loop
Close #1   'Quelldatei schließen

Da ich dir aber meine Subs nicht vorenthalten will, kannst du auch diese haben. Warum ich die Daten erst in die Tabelle "Tmp" importiere rührt daher, dass ich aus den einzelnen Dateien Kopf-/ und Fußzeilen abgeschnitten habe, bevor ich das ganze zu den bestehenden Daten kopiere. Zudem wird der zweite Import im Normalfall rechts an den alten rangekleckst, das wollte ich ohne viel Aufwand umgehen.
Vorsicht! Die Varibale myFileAddress muss hier als Public deklariert werden, da sie an das Unterprogramm übergeben wird.

Private Sub Open_File()
Tabelle2.Select
Range("A1").Select
'Importieren nach TB "Tmp"
With ActiveSheet.QueryTables.Add(Connection:=myFileAddress, Destination:=Range("A1"))
.Name = myFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 2, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Kopf-/Fußzeilen abschneiden
Range("A1").Select
End Sub

Die Optionen zur Connection am besten bestimmen in du über "Externe Daten abrufen" das ganze einmal manuell ausführst und durch dabei den Makrorecorder laufen lässt.
'Temporär abgelegte Daten Verschieben
Private Sub Copy_File()
'Daten markieren, ausschneiden
Selection.CurrentRegion.Select
Selection.Cut
Range("A1").Select
Tabelle3.Select
Application.DisplayAlerts = False
Range("A1").Select
If Range("A1")  "" Then
Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Select
End If
ActiveSheet.Paste
End Sub

Anzeige
AW: Alle.txt-Datei aus einem Ordner importieren
19.08.2015 16:18:09
Matthias
Ach, bevor ich's vergess',
der Nachteil an meiner Variante ist, dass dabei immer eine Connection und ein Bereich entstehen. Das sammelt sich mit der Zeit, wenn dieses Dokument nicht als Vorlage gespeichert wird ganz schön an. Weiss nicht wie es bei dir aussieht, aber mich stört sowas.
Damit kannst du alle entfernen:
'Verbindungen entfernen und Bereiche leeren
Dim objConnection, objName
Application.DisplayAlerts = False
For Each objConnection In ActiveWorkbook.Connections
objConnection.Delete
Next objConnection
For Each objName In ActiveWorkbook.Names
objName.Delete
Next objName
Application.DisplayAlerts = True
Hast du wichtige Connections die du behalten willst/musst, kann ich dir dazu auch noch was geben.
lg Matthias

Anzeige
AW: Alle.txt-Datei aus einem Ordner importieren
20.08.2015 08:47:52
Basti
Guten Morgen Matthias,
vielen Dank für deine Erklärungen und Unterstützung.
Leider reichen meine Copy&Paste-Fähigkeiten nicht aus um deinen Code zum laufen zu bringen.
Ich renne von einer Fehlermeldung zur anderen.
Vieleicht kommt noch jemand mit einer anderen Lösung um die Ecke, die ich kopieren darf ;)
Gruß
Basti

AW: Alle.txt-Datei aus einem Ordner importieren
20.08.2015 09:08:03
Matthias
Guten Morgen Basti,
https://www.herber.de/bbs/user/99694.xlsm
hier hab ich nochmal eine kleine Mitschrift zum Thema Import. Dort ist auch nochmal das vollständige Beispiel drinn. Vielleicht hilft es dir.
lg Matthias

Anzeige
AW: Alle.txt-Datei aus einem Ordner importieren
19.08.2015 13:36:02
Matthias
Hallo Basti,
Dir(Datei)
liefert dir die Datei die du mit GetOpenFile gewählt hast
Dir("*.*")
liefert dir die erste Datei in deinem mit GetOpenFile ermittelten Verzeichnis
Dir
(ohne Angabe von Elementen) wählt die nächste Datei im Verzeichnis
Wenn du weitere Hilfe benötigst, sag bescheid
lg Matthias

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige