Freigegeben Datei prüfen auf User?

[schauan]

Hallo ALexandra,

ja, so könnte es klappen. Durch die verschiedenen Dateien wird das Risiko verringert, dass mehrere User die gleiche Datei bearbeiten wollen. Das Thema Freigabe ist damit vom Tisch.

Eventuell wäre es von Vorteil, wenn Du ein Zeitlimit bei Inaktivität setzt. Dann könnte das Programm / die Userform die Datei(en) schließen und dadurch für andere Nutzer freigeben. Manchmal muss man dringend was anderes machen und denkt nicht dran, dass die Anwendung noch aktiv ist und andere User behindert ... Das könnte aber eher was für eine spätere Optimierung sein, wenn's denn nötig ist.

Optimaler wäre trotzdem, wie schon jemand schrieb, eine Datenbankanwendung. Meist ist es aber so, dass man da nichts an Software hat und auch keine Kenntnisse. Na ja, mit Excel geht's auch - (fast) nichts ist unmööööglich .

[cysu11]

Hallo Andre,

Eventuell wäre es von Vorteil, wenn Du ein Zeitlimit bei Inaktivität setzt. Dann könnte das Programm / die Userform die Datei(en) schließen und dadurch für andere Nutzer freigeben. Manchmal muss man dringend was anderes machen und denkt nicht dran, dass die Anwendung noch aktiv ist und andere User behindert ... Das könnte aber eher was für eine spätere Optimierung sein, wenn's denn nötig ist.

Die Datenbanken wären wirklich nur dann offen beim betätigen der Buttons in den Userformdateien "Anlegen, Änderungen speichern oder Löschen", das heisst nur solange der jeweilige Code ausgeführt wird, das ist 1-2 Sekunden sollte also kein Problem darstellen!

Dann mache ich mich gleich an die Arbeit, eine Frage habe ich noch:

Code:

Sub Datensync()
Dim Dateiname  As String
Dim Datei      As Object
Dim Dateiname2 As String
Dim Zieldatei2 As Object
Dim wsQuelle As Workbook
Dim wsZiel1 As Worksheet
Dim wsZiel2 As Worksheet
Dim wsQuelle1 As Worksheet
Dim wsQuelle2 As Worksheet
   Dateiname = ThisWorkbook.Path & "\" & "testDatenbank.xlsx" ' Datei auswählen
   Dateiname2 = ThisWorkbook.Path & "\" & "TestUF2.xlsm"
   Set Datei = Workbooks.Open(Dateiname) ' Datei öffnen
    Set wsZiel1 = ThisWorkbook.Sheets("Tabelle1")
        wsZiel1.Cells.ClearContents
        wsZiel1.Cells.ClearFormats
    Set wsQuelle1 = Datei.Worksheets("Tabelle1")
    wsQuelle1.Cells.Copy Destination:=ThisWorkbook.Sheets("Tabelle1").Cells
    Set Zieldatei2 = Workbooks.Open(Dateiname2)
    Set wsZiel2 = Zieldatei2.Sheets("Tabelle1")
        wsZiel2.Cells.ClearContents
        wsZiel2.Cells.ClearFormats
    Set wsQuelle1 = Datei.Worksheets("Tabelle1")
    wsQuelle1.Cells.Copy Destination:=Zieldatei2.Sheets("Tabelle1").Cells
    wsQuelle1.Parent.Close SaveChanges:=False
    wsZiel2.Parent.Close SaveChanges:=True
    Set wsQuelle1 = Nothing
    Set wsQuelle2 = Nothing
    Set wsZiel1 = Nothing
    Set wsZiel2 = Nothing
    Application.ScreenUpdating = True
    ThisWorkbook.Save
End Sub

Wie kann ich hier die Prüfung einbauen ob "Zieldatei2" bereits offen ist um das erneute Öffnen mit "Set Zieldatei2 = Workbooks.Open(Dateiname2)" zu vermeiden und um das schließen zu vermeiden falls die Datei bereits offen war von anderen User, sonst würde ich ihm ja die Datei zumachen!


Vielen Dank für dein Hilfe & Gedanken

LG

Alexandra

[cysu11]

Hallo zusammen,


habe den Code jetzt noch angepasst und er funktioniert jetzt sehr gut:

Code:

Sub Datensync()
Dim Quelldateiname  As String
Dim Quelle      As Object
Dim wsZiel1 As Worksheet
Dim wsZiel2 As Worksheet
Dim wsZiel3 As Worksheet
Dim wsZiel4 As Worksheet
Dim wsZiel5 As Worksheet
Dim wsZiel6 As Worksheet

Dim wsQuelle1 As Worksheet
Dim wsQuelle2 As Worksheet
Dim wsQuelle3 As Worksheet
Dim wsQuelle4 As Worksheet
Dim wsQuelle5 As Worksheet
Dim wsQuelle6 As Worksheet
  
   Quelldateiname = ThisWorkbook.Path & "\" & "DB.xlxm" ' Datei auswählen
   Application.ScreenUpdating = False
  
   Set Quelle = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "DB.xlsm", ReadOnly:=True, Password:="", WriteResPassword:="") ' Datei öffnen
    
    Set wsZiel1 = ThisWorkbook.Sheets("produkte")
        wsZiel1.Cells.ClearContents
        wsZiel1.Cells.ClearFormats
    Set wsQuelle1 = Quelle.Worksheets("produkte")
    wsQuelle1.Cells.Copy Destination:=ThisWorkbook.Sheets("produkte").Cells
    
    Set wsZiel2 = ThisWorkbook.Sheets("kunden")
        wsZiel2.Cells.ClearContents
        wsZiel2.Cells.ClearFormats
    Set wsQuelle2 = Quelle.Worksheets("kunden")
    wsQuelle2.Cells.Copy Destination:=ThisWorkbook.Sheets("kunden").Cells
    
    Set wsZiel3 = ThisWorkbook.Sheets("LNA")
        wsZiel3.Cells.ClearContents
        wsZiel3.Cells.ClearFormats
    Set wsQuelle3 = Quelle.Worksheets("LNA")
    wsQuelle3.Cells.Copy Destination:=ThisWorkbook.Sheets("LNA").Cells
    
    Set wsZiel4 = ThisWorkbook.Sheets("zwischen")
        wsZiel4.Cells.ClearContents
        wsZiel4.Cells.ClearFormats
    Set wsQuelle4 = Quelle.Worksheets("zwischen")
    wsQuelle4.Cells.Copy Destination:=ThisWorkbook.Sheets("zwischen").Cells
    
    Set wsZiel5 = ThisWorkbook.Sheets("Attribute")
        wsZiel5.Cells.ClearContents
        wsZiel5.Cells.ClearFormats
    Set wsQuelle5 = Quelle.Worksheets("Attribute")
    wsQuelle5.Cells.Copy Destination:=ThisWorkbook.Sheets("Attribute").Cells
    
    Set wsZiel6 = ThisWorkbook.Sheets("LNK")
        wsZiel6.Cells.ClearContents
        wsZiel6.Cells.ClearFormats
    Set wsQuelle6 = Quelle.Worksheets("LNK")
    wsQuelle6.Cells.Copy Destination:=ThisWorkbook.Sheets("LNK").Cells
      
    Quelle.Close SaveChanges:=False
    
    Set wsQuelle1 = Nothing
    Set wsQuelle2 = Nothing
    Set wsQuelle3 = Nothing
    Set wsQuelle4 = Nothing
    Set wsQuelle5 = Nothing
    Set wsQuelle6 = Nothing

    Set wsZiel1 = Nothing
    Set wsZiel2 = Nothing
    Set wsZiel3 = Nothing
    Set wsZiel4 = Nothing
    Set wsZiel5 = Nothing
    Set wsZiel6 = Nothing

    ThisWorkbook.Save
End Sub

Zwei Sachen würde ich noch gerne verbessern wenn möglich:

1. Den Code optimieren, damit er schneller wird :)
2. Die Quelldatei wird schreibgeschützt aufgemacht, das funktioniert auch wenn die Quelldatei gerade von jemanden bearbeitet wird, aber wie kann ich nur diese schreibgeschützte Datei die mit dem Code ja aufgemacht wird auch wieder schließen, ohne die "Original" die gerade von jemanden bearbeitet wird zu schließen?


Für eure Hilfe danke ich im Voraus
VG
Alexandra

[schauan]

Hallo Alexandra,

erst mal schnell zu 2.
Wenn Du eine Excel-Datei oder auch irgendeine andere schreibgeschützt öffnest, weil ein user sie schon offen hat, dann wird die nur bei Dir geschlossen und nicht beim user.

Zur Optimierung des Makros schaue ich dann noch.

[cysu11]

Hallo Andre,

erst mal schnell zu 2.
Wenn Du eine Excel-Datei oder auch irgendeine andere schreibgeschützt öffnest, weil ein user sie schon offen hat, dann wird die nur bei Dir geschlossen und nicht beim user.

super, vielen Dank für deine Antwort!
Ich bin gespannt, ob man den Code noch optimieren kann!

Vielen Dank
VG
Alexandra

[schauan]

Hallo Alexandra,

ich kann jetzt nicht ganz nachvollziehen, warum Du das Löschen so kompliziert machst. Normalerweise reicht auf einem Arbeitsblatt doch

Code:

Sheets("xxx").Cells.Clear

Unbhängig davon noch drei Hinweise.

1.
Das mit dem = Nothing würde ich gleich an der Stelle machen, wo das entsprechende Objekt nicht mehr benötigt wird. Ansonsten schleppt es Excel bis zum Ende des Makros mit.

2.
Die Blätter kannst Du in ein Array packen und das dann in einer FOR - NEXT - Schleife abarbeiten.

im Prinzip so, mit meinem einfachen Ansatz Cells.Clear:

Code:

Dim arrBlaetter, iCnt%
arrBlaetter=Array("Blatt1","Blatt2",...)
For iCnt=Lbound(arrBlaetter) To Ubound(arrBlaetter)
Sheets(arrBlaetter(iCnt)).Cells.Clear
Next

Statt LBOUND... und UBOUND... kannst Du natürlich gleich die passenden Zahlen einsetzen.

3.
Du kannst Objekte auch mehrmals mit SET neu belegen, ohne es mit Nothing zuvor zurückzusetzen. Du bräuchtest also - wenn es nicht noch für etwas anderes gut sein sollte - nur eine Objektvariable wsZiel und weist ihr immer nur einen neuen Inhalt zu.

Im Prinzip so:

Code:

Dim arrBlaetter, iCnt%, wsZiel as Worksheet
arrBlaetter=Array("Blatt1","Blatt2",...)
For iCnt=Lbound(arrBlaetter) To Ubound(arrBlaetter)
Set wsZiel = Sheets(arrBlaetter(iCnt))
wsZiel.Cells.Clear
Next
Set wsZiel = Nothing

[cysu11]

Guten Morgen Andre,


vielen Dank für deine Vorschläge!

Die Blätter kannst Du in ein Array packen und das dann in einer FOR - NEXT - Schleife abarbeiten.

Damit kann ich nun die Inhalte der ZielBlätter löschen, kann ich damit auch den Inhalt der QuellBlätter kopieren und in die Zielblätter einfügen?


Danke
VG
Alexandra

[schauan]

Hallo Alexandre,

ja, das kann Excel auch Im Prinzip würde ich es mit diesem code machen:

Code:

Dim arrBlaetter, iCnt%
arrBlaetter=Array("Blatt1","Blatt2",...)
For iCnt=Lbound(arrBlaetter) To Ubound(arrBlaetter)
With Thisworkbook.Sheets(arrBlaetter(iCnt))
  .Cells.Clear
  Quelle.Worksheets(arrBlaetter).Cells.Copy Destination:=.Cells
Next

[cysu11]

Hallo Andre,


vielen Dank für deine Hilfe, das schaut ja super aus! :)


VG
Alexandra