'Attribute VB_Name = "FileOpened" 
 'File Offen Frei' 
 Option Explicit
 ' --------------------------------------------------------- 
 ' Funktion: FileOpen 
 ' Eingestellt von: Andre Schau 
 ' Datum: 5. Juno 2006 
 ' Kommentar: weitere Prüfung auf Schreibschutz notwendig, 
 ' bei File mit Schreibschutz wird frei ausgegeben! 
 ' Parameter: sPath fuer Dateiname einschl. LW und Pfad 
 ' Rückgabe:  Schluesselzahl 
 ' Aufruf: 
  Sub TestFileOpen()
  'Integervariablen 
  Dim iFileOpen%
  'Stringvariablen 
  Dim sFile$
  sFile = "d:\test\bintest"
  iFileOpen = FileOpen(sFile)
  ' geht nur 1, 2 oder 0 
  Select Case iFileOpen
    Case 0
      MsgBox "File " & sFile & " frei"
    Case 1
      MsgBox "File " & sFile & " geöffnet"
    Case 2
      MsgBox "File " & sFile & " nicht gefunden"
  End Select
  End Sub
 ' --------------------------------------------------------- 
 
Private Function FileOpen(sPath As String) As Integer
 ' nicht gefunden 
 If Dir(sPath) = "" Then
 FileOpen = 2
 ' gefunden aber? 
 Else
   On Error GoTo errorhandler
   ' Fehler bei Write wenn schon geöffnet 
   ' kommt nicht bei schreibgeschützter Datei 
   Open sPath For Random Access Read Lock Read Write As #1
   Close #1
 End If
 ' Exit eigentlich nicht nötig, wenn alles ok gibt's keinen err 
 Exit Function
errorhandler:
   ' Fehler 70 = File offen 
   If Err = 70 Then FileOpen = 1
 End Function