Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
272to276
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
272to276
272to276
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

2ter Versuch - Datei open - prüfen

2ter Versuch - Datei open - prüfen
30.06.2003 14:09:40
FrankyB
Hi Leute,
ich hatte diese Frage schon einaml gestellt - leider ohne Antwort.
Ich wage einen zweiten Versuch.
...unten aufgeführt habe ich ein Makro von Hans.
Das Makro ist ok, müßte es aber etwas verändern, mir fehlt jedoch die Kenntnis.
Das Makro prüft ob eine Datei bereits geöffnet ist. Sobald der User, der die Datei
in Benutzung hat, diese schließt, soll sie geöffnet werden.
Folgende Änderungen bräuchte ich:
- der Pfad der Datei steht in Tabelle1 Zelle A1
- das Makro soll eine bestimmte Zeit prüfen ob Datei bereits geöffnet ist (vielleicht 30 Sek), falls die
Datei dann noch nicht geschlossen wurde, soll eine MsgBox gezeigt werden "Datei kann nicht geöffnet werden etc..." - und - Prozedur kompl. abbrechen.
- falls in der Zeit die Datei geschlossen wurde, dann Meldung MsgBox "Datei ist frei etc..." (Datei soll aber nicht geöffnet werden!)
Zu schwierig oder zu aufwendig????
Ich bedanke mich im voraus...
Gruß Frank
Sub TestFileOpen()
Dim iOpen As Integer
Dim sFile As String
sFile = InputBox("Path and Filename:", , "c:\test\test.xls")
If sFile = "" Then Exit Sub
Do While TestOpen(sFile) = 1
Loop
Workbooks.Open sFile
End Sub


Private Function TestOpen(sPath As String) As Integer
If Dir(sPath) = "" Then
TestOpen = 2
Else
On Error GoTo ERRORHANDLER
Open sPath For Random Access Read Lock Read Write As #1
Close #1
End If
ERRORHANDLER:
If Err = 70 Then TestOpen = 1
End Function

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2ter Versuch - Datei open - prüfen
30.06.2003 17:45:25
Nepumuk
Hallo Franky,
so eventuell?

Option Explicit
Sub TestFileOpen()
Dim iOpen As Integer, sFile As String, sTime As Date, Timeout As Boolean
sFile = InputBox("Filename:", , "test.xls")
If sFile = "" Then Exit Sub
sTime = Timer
Do While TestOpen(Cells(1, 1) & IIf(Right(Cells(1, 1), 1) <> "\", "\", "") & sFile) = 1 Or Timeout
If Timer - sTime >= 30 Then Timeout = True
Loop
If Timeout Then MsgBox "Wartezeit abgelaufen.", 48, "Hinweis": Exit Sub
MsgBox "Datei ist frei.", 48, "Hinweis"
End Sub


Gruß
Nepumuk

Anzeige
AW: funzt nicht!
30.06.2003 18:52:43
FrankyB
Hi Nepumuk
funktioniert nicht, egal ob die Test Datei zu, oder offen ist, es kommt immer die Meldung
"Datei ist frei."
Ich habe selbst einiges rumprobiert - leider ohne Erfolg. Mir fehlt einfach das Wissen.
Habe ich vielleicht was übersehen?
Gruß Frank

AW: funzt nicht!
30.06.2003 20:14:36
Nepumuk
Hallo Frank,
war mein Fehler, da nicht getestet, sondern nur so auf die schnelle hingeschmiert.
So geht's:

Option Explicit
Private Function TestOpen(sPath As String) As Boolean
On Error GoTo ERRORHANDLER
Open sPath For Random Access Read Lock Read Write As #1
Close #1
TestOpen = True
ERRORHANDLER:
If Err.Number = 70 Then TestOpen = False
End Function
Sub TestFileOpen()
Dim iOpen As Integer, sFile As String, sTime As Double, Timeout As Boolean
Do
sFile = InputBox("Filename:", "Eingabe", "test.xls")
If sFile = "" Then Exit Sub
If Dir(sFile) <> "" Then Exit Do
MsgBox "Datei " & Chr(34) & sFile & Chr(34) & " nicht vorhanden.", 48, "Hinweis"
Loop
sTime = Timer
Do
If Timer - sTime >= 3 Then Timeout = True
Loop Until TestOpen(Cells(1, 1) & IIf(Right(Cells(1, 1), 1) <> "\", "\", "") & sFile) Or Timeout
If Timeout Then MsgBox "Wartezeit abgelaufen.", 48, "Hinweis": Exit Sub
MsgBox "Datei ist frei.", 48, "Hinweis"
End Sub


Gruß
Nepumuk

Anzeige
AW: funzt noch nicht!
30.06.2003 22:56:57
FrankyB
Hi Nepumuk,
funktioniert auch nicht, egal ob die Test Datei zu, oder offen ist, es kommt jetzt immer die Meldung "Wartezeit abgelaufen." und wenn die Datei garnicht vorhanden ist, hängt sich die Prozedur auf.
?????????????
Gruß Frank

AW: funzt noch nicht!
01.07.2003 04:40:28
Nepumuk
Hallo Frank,
da ich eine Datei in meinem Standardverzeichnis prüfen ließ, ist es mir nicht aufgefallen, dass ich den Pfad in der Prüfung vergessen habe. Außerdem habe ich die Prüfzeit auf drei Sekunden heruntergesetzt, da ich nicht immer so lange warten wollte. Aber ansonsten ist es bei mir gelaufen.
Die Korrektur:

Sub TestFileOpen()
Dim iOpen As Integer, sFile As String, sTime As Double, Timeout As Boolean
Do
sFile = InputBox("Filename:", "Eingabe", "test.xls")
If sFile = "" Then Exit Sub
If Dir(Cells(1, 1) & IIf(Right(Cells(1, 1), 1) <> "\", "\", "") & sFile) <> "" Then Exit Do
MsgBox "Datei " & Chr(34) & sFile & Chr(34) & " nicht vorhanden.", 48, "Hinweis"
Loop
sTime = Timer
Do
If Timer - sTime >= 30 Then Timeout = True
Loop Until TestOpen(Cells(1, 1) & IIf(Right(Cells(1, 1), 1) <> "\", "\", "") & sFile) Or Timeout
If Timeout Then MsgBox "Wartezeit abgelaufen.", 48, "Hinweis": Exit Sub
MsgBox "Datei ist frei.", 48, "Hinweis"
End Sub


Gruß
Nepumuk

Anzeige
AW: funktioniert einfach nicht
01.07.2003 09:08:40
FrankyB2
Hi Nepumuk,
funktioniert einfach nicht, egal ob die Test Datei zu, oder offen ist, es kommt jetzt immer die Meldung "Datei... nicht vorhanden".
Ich habe das Makro auf Excel 8/97 getestet. Pfad C:\Temp\test.xls
Ich kann es auch mal auf Excel 9/2000 testen?
Gruß Frank

AW: funktioniert einfach nicht
01.07.2003 18:26:09
Nepumuk
Hallo Frank,
mit Excel97 kann ich es nicht testen, habe nur 2000 und XP. Bei mir läuft es einwandfrei. Jetzt kann ich dir leider nicht mehr weiterhelfen.
Gruß
Nepumuk

AW: Danke
01.07.2003 22:41:38
FrankyB
Hi Nepumuk,
danke dir für deine Mühe.
Ich werde es auf der 2000er Version ausprobieren und durchtesten - vielleicht bringt das was.
Letztendlich brauche ich das Makro aber für beide Versionen.
Gruß Frank

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige