Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1544to1548
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

Mehrere TXT Auslesen

Mehrere TXT Auslesen
01.03.2017 10:07:39
Manu
Hallo zusammen,
ich habe einen Code hier im Forum gefunden der nahezu alles bietet was ich brauche. Habe es auch soweit anpassen können das es mit meiner txt passt.
Ich ich aber möchte und leider nach Tagerlanger suche und Versuche, nicht hinbekommen habe.
Ich möchte das sich ein Fenster öffnet in dem man die txt Dateien auswählen kann (können schon mal 100 txt Dateien sein).
Hier mal der Code:
Sub Suche_in_TXT()
Dim sWord As String, sPath As String, sSearchPath As String, FileName As String, InputData
Dim AnzFound As Integer
AnzFound = 0
sWord = "Failed" 'Suchwort
sSearchPath = "C:\Users\xxxx\*.txt"
sPath = "C:\Users\xxxx\"
FileName = Dir(sSearchPath)
If FileName  "" Then
Do While FileName  ""
Open sPath & FileName For Input As #1
Do While Not EOF(1)
Line Input #1, InputData
If InStr(1, InputData, sWord) > 0 Then 'Zeile mit Suchwort (sWord) gefunden
AnzFound = AnzFound + 2 'in jeder Zeile Schreiben (2 jede zweite)
Sheets("Analyse_Alle").Cells(AnzFound, 1) = FileName '1 = Spalte A
Sheets("Analyse_Alle").Cells(AnzFound, 2) = InputData '2 = Spalte B
End If
Loop
Close #1
FileName = Dir
Loop
End If
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Öffnendialog für mehrere...
01.03.2017 11:02:36
Case
Hallo Manu, :-)
... TXT-Dateien geht so der Spur nach (Dein restlicher Code funktioniert ja - den habe ich nur reinkopiert): ;-)
Option Explicit
Public Sub Main()
Dim InputData As String
Dim intFiles As Integer
Dim varFiles As Variant
Dim AnzFound As Integer
Dim sWord As String
On Error GoTo Fin
varFiles = Application.GetOpenFilename( _
FileFilter:="Excel-Dateien (*.txt), *.txt", _
MultiSelect:=True)
If Not VarType(varFiles) = vbBoolean Then
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
sWord = "Failed" 'Suchwort
For intFiles = 1 To UBound(varFiles)
Open varFiles(intFiles) For Input As #1
Do While Not EOF(1)
Line Input #1, InputData
If InStr(1, InputData, sWord) > 0 Then 'Zeile mit Suchwort (sWord) gefunden
AnzFound = AnzFound + 2 'in jeder Zeile Schreiben (2 jede zweite)
Sheets("Analyse_Alle").Cells(AnzFound, 1) = varFiles(intFiles) '1 Spalte A
Sheets("Analyse_Alle").Cells(AnzFound, 2) = InputData '2 Spalte B
End If
Loop
Close #1
Next intFiles
Else
MsgBox "Abbruch!", vbInformation, "Dateiauswahl!"
End If
Fin:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Wenn es nicht klappt, dann stelle mal eine Textdatei zur Verfügung, damit wir uns das anschauen können.
Servus
Case

Anzeige
Funktioniert
01.03.2017 11:12:04
Manu
Vielne vielen Dank.
Funktioniert wunderbar.
Dein Code ist sehr komplex, das hätte ich nie hinbekommen.
Grüße aus dem Schwarzwald
Manu
Gerne! Danke für die Rückmeldung, owT
01.03.2017 11:22:30
Case
:-)
Nice to Have
03.03.2017 10:15:22
Manu
Hallo Case,
ich hätte da noch ein Nice to Have. Ist nicht zwingend notwendig aber wäre eine super sache.
Kann man es so Programmieren das bei öffnen des explorer mir über CMD ein Netzwerklaufwerk öffnet und ich die txt Dateien darin suche und nach abschluss der Übertragenen Dateien mir das Laufwerk wieder schließt.
Sprich diese beiden CMD Codes mit einprogrammieren:
net use s: \\10.26.21.162\C$ /user:admin password /persistent:no
Schließen
net use s: /delete
Gruß
Manu
Anzeige
Auch das ist kein...
03.03.2017 10:45:55
Case
Hallo Manu, :-)
... Problem. Kann es nur gerade nicht testen um Dir die richtige Syntax zu schreiben. Schau doch mal in einer Suchmaschine Deiner Wahl nach Shell("net use...
Oder Du probierst es mit:
Dim objNetwork as Object
Set objNetwork = CreateObject("Wscript.Network")
objNetwork.MapNetworkDrive "S:", "\\ServerOderIP\Freigabe", False, "Benutzer", "Passwort"
'.... Mach was
objNetwork.RemoveNetworkDrive "S:"
Das ist jetzt alles ins blaue reingeschrieben und nicht getestet. ;-)
Servus
Case

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige