AW: Auslesen Ersteller Besitzer einer Datei
27.04.2010 10:49:47
alexander
Hallo Anton,
danke das Makro ist echt Klasse, auch wenn es ein Moment dauerte dahinter zu steigen.
Hier für alle auch noch einmal die Lösung, wie ich es jetzt umgesetzt habe.
Sub NCProg()
Dim Eingabeaufforderung As Date
Var1 = InputBox("Geben Sie das Datum was sie einlesen möchten", "Abfrage", Date)
If Var1 "" Then
GoTo anfang
End If
If Var1 = "" Then
GoTo ende
End If
anfang:
'Alle Meldungen aus
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
'Alte Daten löschen
' alle Dateien des Ordners anzeigen in Indexdatei
Dim datei As Object
Dim objShell, objFolder As Object
Pfad = Cells(3, "B")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("\\DEKLI1S5020\5020-App$\Coscom\CNC\WINTOOL\" & Pfad & "\ _
")
If objFolder = "" Then GoTo ende
For Each datei In objFolder.items
If LCase(datei) Like "*.inp" And DateValue(objFolder.GetDetailsOf(datei, 5)) = _
DateValue(Var1) Then
'Dateiname auslesen
prognam = "'" & Right(Left$(datei, InStrRev(datei, ".") - 1), 6)
'Besitzer auslsen
besitzer = objFolder.GetDetailsOf(datei, 8)
larX = 1 + Cells(Rows.Count, 1).End(xlUp).Row 'Letzte Zeile
'Daten schreiben
Cells(larX, 1) = prognam
Cells(larX, 1).Interior.Color = 15773696
Cells(larX, 2) = Date
Cells(larX, 3) = "X"
Cells(larX, 6) = Mid(besitzer, 8, (Len(besitzer) - 7))
End If
Next
ende:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub