Ich hab wiedermal ein kleines Problem: Hoffentlich kann mir da jemand weiterhelfen. Ich kopiere Daten von einem Tabellenblatt aus einer Mappe mit Daten (die auf einem Server liegt) unter einem bestimmten Filter Kriterium, das der Benutzer in der Ziel Mappe über ein Auswahl Feld auswählen kann in diese hineinkopiert. Das funktioniert auch im Grunde.
Aber: Im Moment verwende ich eine Funktion die ich von der Microsoft Seite hab die prüfen sollte ob die Mappe schon offen ist. Ich hatte die Funktion leider missverstanden, denn sie Prüft nicht nur ob ICH die Mappe offen habe. Sondern auch ob jemand grundsätzlich gerade über den Server darauf zugreift. Wenn das der fall ist dann kommt ein Fehler. Wenn ich selbst es bin dann nicht aber es wird die Mappe genutzt die ich grad offen habe und das will ich nicht.
Ich will aber das die Mappe mit den Daten in jedem fall schreibgeschützt geöffnet wird, mein Kopiercode ausgeführt wird und die Mappe dann wider geschlossen unabhängig ob sie jemand offen hat. Also auch wenn ich selbst sie offen hab soll sie in einer zweiten Instanz Schreibgeschützt geöffnet werden und dann wider geschlossen.
Hat Jemand zufälligerweise so eine Funktion an die man dann den Pfad der datrei übergeben kann?
Das ist die Funktion die ich derzeit verwende:
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Schaltet die Fehlerprüfung aus.
filenum = FreeFile() ' Erhalte eine freien Dateinummer.
' Versuchen Sie, die Datei zu öffnen und sie zu sperren.
Open filename For Input Lock Read As #filenum
Close filenum ' Schließen Sie die Datei.
errnum = Err ' Speichern Sie die aufgetretene Fehlernummer.
On Error GoTo 0 ' Schalten Sie die Fehlerprüfung erneut ein.
' Überprüfen Sie, welcher Fehler aufgetreten ist.
Select Case errnum
' Es ist kein Fehler aufgetreten.
' Datei ist NICHT bereits von einem anderen Benutzer geöffnet.
Case 0
IsFileOpen = False
' Fehlernummer für "Zugriff verweigert"
' Die Datei wurde bereits von einem anderen Benutzer geöffnet.
Case 70
IsFileOpen = True
' Ein weiterer Fehler ist aufgetreten.
Case Else
Error errnum
End Select
End Function
Vielen Dank für eure Hilfe
Beste Grüße
Markus