Hallo
Ich versuche derzeit eine Liste zu aktualisieren. Dafür muss ich eine txt. Datei öffnen und eben finden ;) und sie auslesen. Im moment versuche ich nur die datei zu finden und zu öffnen. Ich hoffe es ist einigermaßen verständlich. Wär super wenn du mir irgwie ein wenig weiterhelfen würdest :)
Danke
Hier alles was ich bis jetzt habe
Option Explicit
Const strLaufwerk As String = "Z:\\DTSV"
Const strCheckinDatName As String = "fCheckInDat"
Sub M2_Fahrzeugtyp()
Dim intZeile As Integer
Dim Pfad As String
Dim strCheckinFullName As String
Dim fs As Object
Dim fVerz As Object
'Dim fDatei As Object
'Dim fDateien As Object
Dim fDir As Object
Dim fNeuesteDir As Object
Dim fUnterverz As Object
Dim strDat As String
Dim maxDatum As Date
Dim fCheckInDat As Object
Dim fDat As Object
With Tabelle1
intZeile = 2
Do While Not IsEmpty(.Cells(intZeile, 1))
Pfad = strLaufwerk & "\DTSV_" & .Cells(intZeile, 1) & "\" & _
.Cells(intZeile, 10) & "\" & .Cells(intZeile, 5)
Debug.Print "Pfad der Zeile " & intZeile & " ist: " & Pfad
Set fs = CreateObject("Scripting.FileSystemObject")
Set fVerz = fs.getFolder(Pfad)
Set fUnterverz = fVerz.Subfolders
Set fNeuesteDir = Nothing
maxDatum = 0
For Each fDir In fUnterverz
Debug.Print "Item: " & fDir.Name & " -- " & _
fDir.DateLastModified
If fDir.DateLastModified > maxDatum Then
maxDatum = fDir.DateLastModified ' Neueresjungstes Datum merken
Set fNeuesteDir = fDir ' Neues jüngeres Unterverz.merken
End If
Next fDir
Debug.Print "Das neue Verzeichnis ist: " & Pfad & "\" & _
fNeuesteDir.Name
Set fVerz = fs.getFolder(Pfad)
Set fDir = fVerz.Files
Set fCheckInDat = Nothing
For Each fDat In fDir
If InStr(fDat.Name, .Cells(intZeile, 5)) = 1 And (InStr(fDat.Name, "CheckIn.txt") > 0 Or InStr(fDat.Name, "ChekOut.txt") > 0) Then
Set fCheckInDat = fDat
Exit For
End If
Next fDat
If fCheckInDat Is Nothing Then
MsgBox ("Keine " & .Cells(intZeile, 5) & "_*_CheckIn.txt oder " & .Cells(intZeile, 5) & "_*_CheckOut.txt Datei in " & Pfad & " gefunden!")
Exit Sub
End If
strCheckinFullName = Pfad & "\" & fNeuesteDir.Name & "\" & _
strCheckinDatName
Workbooks.OpenText Filename:=strCheckinFullName, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, Other:=True, OtherChar:="|", _
FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
MsgBox "Datei " & strCheckinFullName
Workbooks(strCheckinDatName).Close SaveChanges:=False
intZeile = intZeile + 1
Loop
End With
End Sub
|