Prüfung ob Datei bereits offen!

[cysu11]

Hallo liebe Excelgemeinde,


würde gerne beim Betätigen des Buttons "Löschen" mit folgenden Code zuerst prüfen ob die Datei "DB.xlsm" im Netzwerk bereits offen ist, wenn ja dann MsgBox"Bitte versuchen Sie es später noch einmal!", wenn nicht, dann den Code weiterlaufen lassen!!

Code:

Private Sub cmdLöschen_Click()
    Dim var
   Dim rngLoeschWert As Range
   'falls aus der Listbox kein Element gewählt ist verlasse die Sub
   If lstAttribute.ListIndex = -1 Then
       MsgBox "Bitte Attribut auswählen!"
   Exit Sub
   End If
    var = MsgBox("Sind Sie sicher, dass Sie den Begriff " & lstAttribute.Value & " aus der Kategorie " & " " & ComboBox1.Value & " " & "löschen möchten? ", vbYesNo)
     If var = 7 Then
         Exit Sub
         Else
   Set DB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "DB.xlsm", ReadOnly:=False, Password:="", WriteResPassword:="")
      'suchen des Wertes in der betreffenden Spalte
   Set rngLoeschWert = DB.Worksheets("Attribute").Columns(rngUberschriften.Column).Find(lstAttribute.Value, LookIn:=xlValues, lookat:=xlWhole)
   If Not rngLoeschWert Is Nothing Then
      'und lösche ihn und schiebe die weiteren nach oben
      rngLoeschWert.Delete xlShiftUp
   End If
   End If
    lstAttribute.RemoveItem lstAttribute.ListIndex
    DB.Close SaveChanges:=True
        Datensync
    ThisWorkbook.Save
End Sub

Wie muss der Code dann aussehen?


Vielen Dank im Voraus
VG
Alexandra

[schauan]

Hallo Alexandra,

wenn Du auf Schreibschutz einer Excel-Datei nach dem Öffnen prüfen würdest, dann geht das über die ReadOnly-Eigenschaft vom Workbook:

ActiveWorkbook.ReedOnly

Dafür öffnest Du die Mappe kurz im Hintergrund, prüfst die Eigenschaft und schließt sie bei Bedarf wieder.

[cysu11]

Hallo Andre,


vielen Dank für dein Beitrag!
Ich dachte eher an sowas:

Code:

Option Explicit

Public Enum XL_FILESTATUS
    XL_UNDEFINED = -1
    XL_CLOSED
    XL_OPEN
    XL_DONTEXIST
End Enum

Public Function FileStatus(xlFile As String) As XL_FILESTATUS

On Error Resume Next

Dim File%: File = FreeFile

Err.Clear

Open xlFile For Binary Access Read Lock Read As #File
Close #File

Select Case Err.Number
    Case 0: FileStatus = XL_CLOSED
    Case 70: FileStatus = XL_OPEN
    Case 76: FileStatus = XL_DONTEXIST
    Case Else: FileStatus = XL_UNDEFINED
End Select

End Function

Sub PrüfungDateiOffen()
Dim strFile As String

strFile = "C:\Users\rabe\Downloads\DB.xlsm"

If FileStatus(strFile) = XL_CLOSED Then
    Return
    'Workbooks.Open Filename:=strFile
    Else
    MsgBox "Datenbank wird bereits bearbeitet, bitte versuchen Sie es später noch einmal!"
Exit Sub
End If

End Sub

Das funktioniert ganz gut, ABER...
Habe diesen Code in ein Modul4 rein und "PrüfungDateiOffen" am Anfang meines "Lösch" Codes eingefügt allerdings kommt zwar die Meldung "Datenbank wird bereits bearbeitet..." aber der Löschcode läuft weiter wenn ich auf OK klicke!

Woran liegt das?

Vielen Dank
VG
Alexandra

[Steffl]

Hallo Alexandra,

wenn Dein Makro so

Code:

Sub DeinMakro()

'Variablendekleration

PrüfungDateiOffen

' weiterer Löschcode

End Sub

ist es klar, das der Code weitergemacht wird. Du mußt entweder den Code in deinen LöschCode integrieren oder aus der Sub eine Function mit einem Rückgabewert machen und den in deinem Löschcode prüfen.

[schauan]

Hallo Alexandra,

das Du so einen code möchtest, hab ich nicht erwartet Der code ist zwar top, aber der andere wäre einfacher :17: Im Prinzip wird die Datei mit der Function ja auch geöffnet und dann wieder geschlossen. Wenn Du sie brauchst, machst Du sie ein zweites mal auf. Wenn Du den Workbook - Status wie von mir vorgeschlagen anhand der offenen Datei prüfst, brauchst Du sie nicht ein zweites mal zu Öffnen.

Das Öffnen als Binärdatei hat den Vorteil, dass die ganzen Excel-Aktionen wie Berechnen oder Aktualisieren nicht ausgeführt werden, wodurch das schneller gehen sollte. Andererseits könnte man die Aktionen vor dem Öffnen deaktivieren und wenn die Datei offen bleiben soll, dann per code nachholen.

[cysu11]

Hallo Andre,

danke für dein Antworten!

oder aus der Sub eine Function mit einem Rückgabewert machen und den in deinem Löschcode prüfen.

Wie würde denn so etwas aussehen in mein Code?


Vielen Dank
VG
Alexandra

[Steffl]

Hallo Alexandra,

das mit Sub -> Function habe ich geschrieben und nicht André und gemeint habe ich es so

Code:

Option Explicit
Public Enum XL_FILESTATUS
    XL_UNDEFINED = -1
    XL_CLOSED
    XL_OPEN
    XL_DONTEXIST
End Enum

Public Function FileStatus(xlFile As String) As XL_FILESTATUS

On Error Resume Next

Dim File%: File = FreeFile

Err.Clear

Open xlFile For Binary Access Read Lock Read As #File
Close #File

Select Case Err.Number
    Case 0: FileStatus = XL_CLOSED
    Case 70: FileStatus = XL_OPEN
    Case 76: FileStatus = XL_DONTEXIST
    Case Else: FileStatus = XL_UNDEFINED
End Select

End Function

Function PrüfungDateiOffen() As Boolean
Dim strFile As String

PrüfungDateiOffen = True
strFile = "C:\Users\rabe\Downloads\DB.xlsm"

If FileStatus(strFile) = XL_CLOSED Then
    Return
    'Workbooks.Open Filename:=strFile
    Else
    MsgBox "Datenbank wird bereits bearbeitet, bitte versuchen Sie es später noch einmal!"
Exit Function

End If
PrüfungDateiOffen = False
End Function
Sub DeinMakro()

'Variablendekleration

If PrüfungDateiOffen Then Exit Sub

' weiterer Löschcode

End Sub

[cysu11]

Hallo Stefan,


entschuldige, ich habe schon Augenkrebs :)


Ich habe dein Code jetzt eingebaut, wenn die Datei offen ist, dann kommt die Meldung und es passt alles!
Wenn die Datei aber geschlossen ist, dann kommt eine Fehlermeldung "Laufzeitfehler 3" Return ohne Gosub!

Was heißt den das?

Vielen dank
VG
Alexandra

[Steffl]

Hallo Alexandra,

kommentier diese Codezeile aus.

[cysu11]

Hallo Stefan,


suuuuuper, jetzt funktioniert es! :97:

Ein Frage habe ich noch! :)

Code:

Private Sub cmdLöschen_Click()
    Dim var
   Dim rngLoeschWert As Range
   If PrüfungDateiOffen Then Exit Sub
   'falls aus der Listbox kein Element gewählt ist verlasse die Sub
   If lstAttribute.ListIndex = -1 Then
       MsgBox "Bitte Attribut auswählen!"
   Exit Sub
   End If
    var = MsgBox("Sind Sie sicher, dass Sie den Begriff " & lstAttribute.Value & " aus der Kategorie " & " " & ComboBox1.Value & " " & "löschen möchten? ", vbYesNo)
     If var = 7 Then
         Exit Sub
         Else
   Set DB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "DB.xlsm", ReadOnly:=False, Password:="", WriteResPassword:="")
      'suchen des Wertes in der betreffenden Spalte
   Set rngLoeschWert = DB.Worksheets("Attribute").Columns(rngUberschriften.Column).Find(lstAttribute.Value, LookIn:=xlValues, lookat:=xlWhole)
   If Not rngLoeschWert Is Nothing Then
      'und lösche ihn und schiebe die weiteren nach oben
      rngLoeschWert.Delete xlShiftUp
   End If
   End If
    lstAttribute.RemoveItem lstAttribute.ListIndex
    DB.Close SaveChanges:=True
        'Datensync
    ThisWorkbook.Save
End Sub

Mit dem Löschcode lösche ich über meine Eingabedatei "Userform" aus der Datei "DB.xlsm"(diese benutze ich als Datenbank und wird nur zum beschreiben kurz aufgemacht und dann wieder geschlossen!) bestimmte Werte!
Nun funktioniert es auch dank deiner Hilfe SUPER, das was mit aber garnicht gefällt, ist, dass wenn ich den Code Löschen ausführe, dann ja die Datei DB.xlsm geöffnet wird und das ja alles zu sehen ist was da passiert! Das ist sehr unschön!
Gibt es eine Möglichkeit, dass das alles im Hintergrund passiert, so dass man das alles nicht sieht?

Vielen lieben Dank
VG
Alexandra