PDA

Vollständige Version anzeigen : Dateiname und Pfad.


schlarb
24.11.2000, 18:14
Hallo zusammmen,
Sachverhalt --> 1=Dateiexport
DoCmd.TransferText acImportDelim, "Komponente", "Montage_daten","C:\QS_FTP\Montage\Ausschuss.txt", False, ""
2= Dateiexport gleicher Vorgang

Nun meine Frage:
Ich möchte aus dem Verzeichnis C:\QS_FTP\montage\Ausschuss.txt die Dateigröße und das Datum ermitteln und in eine Tabelle zurückschreiben.
Das gleiche auch für den Export.
Wie kann man das Bewerkstelligen. Dient als Ereignisprotokol.
Für Info's oder Ansätze Dankbar,
Michael.

Manuela Kulpa
25.11.2000, 08:42
Hallo Michael!

Du hast zwei Möglichkeiten die Informationen zu beschaffen, einmal über API und einmal über das FileSystemObject. Wobei ich letzteres befürworte!

Folgende Routinen benötigen die Objektbibliothek Microsoft Scripting Runtime und funktionieren daher nur mit A2K oder A97, wenn auf deinem Rechner entweder WSH (Windows Scripting Host), der IE 4.0 oder höher bzw. ein Office 2K-Programm installiert ist.

Erstell dir ein neues Modul, und kopiere folgendes in dieses rein (die Erklärungen findest du im Code). Vergess nicht, vor Aufruf, das Modul zu komplieren (Debuggen - kompilieren von ...)

Option Compare Database
Option Explicit


' Die Struktur
Public Type FileInformation
sCompletePath As String
sPath As String
sFileName As String
dDateCreate As Date
dDateLastAccessed As Date
dDateLastModified As Date
dblSize As Double
End Type


' Die Funktion
Sub FileInfo(uFileData As FileInformation)

On Error GoTo Err_FileInfo

Dim objFso As Object
Dim objFile As Object

Set objFso = CreateObject("Scripting.FileSystemObject")

'// Prüfen, ob der Quelldateipfad gültig ist
With uFileData
If Not objFso.FileExists(.sCompletePath) Then
MsgBox "Die Datei konnte nicht gefunden werden!", vbInformation, "Info"
Exit Sub
End If

' Informationen beschaffen
Set objFile = objFso.GetFile(.sCompletePath)
' Pfad
.sPath = objFso.GetParentFolderName(.sCompletePath)
' Dateiname
.sFileName = objFile.Name
' Dateigrösse in KB
.dblSize = objFile.Size
' Erstelldatum
.dDateCreate = objFile.DateCreated
' Letzer Zugriff
.dDateLastAccessed = objFile.DateLastAccessed
' Letzte Veränderung
.dDateLastModified = objFile.DateLastModified

End With

Exit_FileInfo:
Exit Sub

Err_FileInfo:
' Ups, ein Fehler ist aufgetreten
Dim sNachricht As String
sNachricht = "Es ist ein Fehler aufgetreten:" & Chr(10) & Chr(13)
sNachricht = sNachricht & Error
MsgBox sNachricht, 48, "Datei-Information"
' Nichts desto
Resume Exit_FileInfo

End Sub


Sub WriteFileInfo(sImportExportFile As String)

On Error GoTo HandleErr

'// *************************************************************************
'// Die Struktur der Tabelle tblExportImportInfo
'// Feldname Feldtyp Sonstiges
'// flID AutoWert PrimaryKey
'// fsKompletterPfad Text Indiziert: Ja (Duplikate möglich)
'// fsVerzeichnis Text
'// fsDateiname Text
'// fsDateigroesse Zahl Typ: Double - Rückgabe KB
'// fdErstelldatum Datum
'// fdLetzterZugriff Datum
'// fdLetzteVeraenderung Datum
'// *************************************************************************

' für die Typevariable
Dim uFile As FileInformation

' für die Hinterlegung der Informationen
Dim db As DAO.Database
Dim rs As DAO.Recordset

' Objektzuweisung
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblExportImportInfo", dbOpenDynaset)

uFile.sCompletePath = sImportExportFile

' Aufruf der Informationsfunktion
Call FileInfo(uFile)

With uFile
' Wurden Informationen gefunden
If Len(.sFileName) > 0 Then
' Lege einen neuen Datensatz an
rs.AddNew
rs.Fields("fsKompletterPfad") = .sCompletePath
rs.Fields("fsDateiname") = .sFileName
rs.Fields("fsVerzeichnis") = .sPath
rs.Fields("fsDateigroesse") = .dblSize / 1024
rs.Fields("fdErstelldatum") = Format(.dDateCreate, "YYYY-MM-DD")
rs.Fields("fdLetzterZugriff") = Format(.dDateLastAccessed, "YYYY-MM-DD")
rs.Fields("fdLetzteVeraenderung") = Format(.dDateLastModified, "YYYY-MM-DD")
' speicher die Einträge
rs.Update
End If
End With

ExitHere:
If Not rs Is Nothing Then rs.Close: Set rs = Nothing
If Not db Is Nothing Then db.Close: Set db = Nothing
Exit Sub

HandleErr:
' Ups, ein Fehler ist aufgetreten
Dim sNachricht As String
sNachricht = "Es ist ein Fehler aufgetreten:" & Chr(10) & Chr(13)
sNachricht = sNachricht & Error
MsgBox sNachricht, 48, "Schreibe Import/Export Info"
' Nichts desto
Resume ExitHere
End Sub

Der Aufruf erfolgt in deiner Prozedur nach dem Import/Export mit

Call WriteFileInfo("C:\QS_FTP\montage\Ausschuss.txt")

Falls du Fragen hast, melde dich!

Schönes Wochenende