ich lasse aus einer Userform in Abhängigkeit der TextBox2 in verschiedene Dateien und Pfade schreiben. Nun möchte ich abfragen ob die Datei, in die die Daten geschrieben werden sollen, offen ist. Das gelingt mir nur bei der ersten Abfrage
Private Sub CommandButton1_Click()
Abfrage ob die Datei offen ist
Dim Pfad As String
Dim iOpen As Byte
Pfad = _
"P:\Krankmeldungen\Krankschreibungen\Meldungen.xls"
iOpen = DateiIstFrei(Pfad)
Select Case iOpen 'wenn iOpen = 0 ist die Datei geschlossen und das Makro geht nach End _
Select weiter
Case 0
' MsgBox "Datei " & Pfad & " ist frei !"
Case 1 'wenn iOpen = 1 ist die Datei offen und das Makro wird mit End Sub
beendetMsgBox "Sicherungs - Datei - Meldungen an die Personalabteilung - ist gerade geöffnet bitte noch mal abschicken!" _
& vbCr & vbCr & "Datei geöffnet durch:" & " " & Application.UserName, vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
Case 2 'wenn iOpen = 2 ist die Datei nicht da und das Makro wird mit End Sub beendet
MsgBox "Datei " & Pfad & " wurde nicht gefunden !" _
& vbCr & vbCr & "Makro-Abbruch !", vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End Select
'==================================================================
If "Logistik" = TextBox2 Then
Workbooks.Open Filename:="P:\Krankmeldungen\Logistik\Logistik.xls"
Sheets("Krankmeldung").Activate
Range("A3").Select
Set ZFT = Sheets("Krankmeldung").[A3]
While ZFT ""
Set ZFT = ZFT.Offset(1, 0)
Wend
Dim ZEingabe2 As Range 'Deklaration einer Variablen
'Zeiger auf Zelle A2 auf dem Blatt Eingabe setzen
Set ZEingabe2 = Sheets("Krankmeldung").[c2]
While ZEingabe2 "" 'Prüft ob Zelle leer
'wenn Zelle A2 belegt eine Zelle nach unten
Set ZEingabe2 = ZEingabe2.Offset(1, 0)
Wend
'wert aus ComboBox1 in erste leere Zelle der Spalte A schreiben
'Abteilung
ZEingabe2 = Me.ComboBox1
'wert 2 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe2.Offset(0, -1) = Me.TextBox1
'wert 3 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe2.Offset(0, -2) = Me.TextBox2
'wert 4 Zellen nach rechts aus TextBox3 schreiben Krank ab
ZEingabe2.Offset(0, 1) = CDate(Me.cboDatum)
'wert 5 Zellen nach rechts aus TextBox4 schreiben Krank bis
ZEingabe2.Offset(0, 2) = cboUhrzeit 'TextBox4 als datumsformat ausgeben
'wert 5 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe2.Offset(0, 3) = Me.ComboBox2
Windows("Logistik.xls").Activate
Sheets("Krank").Activate
ActiveWorkbook.Save
ActiveWindow.Close
End If
'==================================================================
If "Automation" = TextBox2 Then
Workbooks.Open Filename:="P:\Krankmeldungen\Automation\Automation.xls"
Sheets("Krankmeldung").Activate
Range("A3").Select
Set ZFT = Sheets("Krankmeldung").[A3]
While ZFT ""
Set ZFT = ZFT.Offset(1, 0)
Wend
Dim ZEingabe3 As Range 'Deklaration einer Variablen
'Zeiger auf Zelle A2 auf dem Blatt Eingabe setzen
Set ZEingabe3 = Sheets("Krankmeldung").[c2]
While ZEingabe3 "" 'Prüft ob Zelle leer
'wenn Zelle A2 belegt eine Zelle nach unten
Set ZEingabe3 = ZEingabe3.Offset(1, 0)
Wend
'wert aus ComboBox1 in erste leere Zelle der Spalte A schreiben
'Abteilung
ZEingabe3 = Me.ComboBox1
'wert 2 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe3.Offset(0, -1) = Me.TextBox1
'wert 3 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe3.Offset(0, -2) = Me.TextBox2
'wert 4 Zellen nach rechts aus TextBox3 schreiben Krank ab
ZEingabe3.Offset(0, 1) = Me.cboDatum
'wert 5 Zellen nach rechts aus TextBox4 schreiben Krank bis
ZEingabe3.Offset(0, 2) = cboUhrzeit 'TextBox4 als datumsformat ausgeben
'wert 5 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe3.Offset(0, 3) = Me.ComboBox2
Windows("Automation.xls").Activate
Sheets("Krank").Activate
ActiveWorkbook.Save
ActiveWindow.Close
End If
'==================================================================
If "CO" = TextBox2 Then
Workbooks.Open Filename:="P:\Krankmeldungen\CO\CO.xls"
Sheets("Krankmeldung").Activate
Range("A3").Select
Set ZFT = Sheets("Krankmeldung").[A3]
While ZFT ""
Set ZFT = ZFT.Offset(1, 0)
Wend
Dim ZEingabe4 As Range 'Deklaration einer Variablen
'Zeiger auf Zelle A2 auf dem Blatt Eingabe setzen
Set ZEingabe4 = Sheets("Krankmeldung").[c2]
While ZEingabe4 "" 'Prüft ob Zelle leer
'wenn Zelle A2 belegt eine Zelle nach unten
Set ZEingabe4 = ZEingabe4.Offset(1, 0)
Wend
'wert aus ComboBox1 in erste leere Zelle der Spalte A schreiben
'Abteilung
ZEingabe4 = Me.ComboBox1
'wert 2 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe4.Offset(0, -1) = Me.TextBox1
'wert 3 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe4.Offset(0, -2) = Me.TextBox2
'wert 4 Zellen nach rechts aus TextBox3 schreiben Krank ab
ZEingabe4.Offset(0, 1) = Me.cboDatum
'wert 5 Zellen nach rechts aus TextBox4 schreiben Krank bis
ZEingabe4.Offset(0, 2) = cboUhrzeit 'TextBox4 als datumsformat ausgeben
'wert 5 Zellen nach rechts aus TextBox1 schreiben Vornamen
ZEingabe4.Offset(0, 3) = Me.ComboBox2
Windows("CO.xls").Activate
Sheets("Krank").Activate
ActiveWorkbook.Save
ActiveWindow.Close
End If
Unload UserForm3
End Sub
Function:
' Prüfen ob eine bestimmte Datei offen ist.
Function DateiIstFrei(sDateiname As String) As Byte
If Dir(sDateiname) = "" Then 'prüft ob die Datei sDateiname "Datens" offen ist
DateiIstFrei = 2 'wenn DateiIstFrei = 0 ist die Datei geschlossen, bei 1 = offen, bei 3 = nicht vorhanden
Else
On Error GoTo ERRORHANDLER
Open sDateiname For Random Access Read Lock Read Write As #1
Close #1
End If
ERRORHANDLER:
If Err = 70 Then DateiIstFrei = 1
End Function Gruß Werner