Beim Speichern Daten übertragen

Hallo zusammen,
würde gerne Eure Meinung zu folgendem Vorhaben hören/lesen. Ich hatte in folgendem Beitrag https://www.herber.de/forum/archiv/1076to1080/t1077439.htm bereits Eure Hilfe erhalten und das funktioniert auch sehr gut. Es geht vom Prinzip um`s gleiche Thema nur anders gelöst. Im alten Beitrag wurden Daten ausgelesen und importiert. Nun möchte ich gerne beim Speichern die Daten übertragen. Ich erhoffe mir dadurch einen kleinen Zeitvorteil (für mich).
In einer Excel-Anwendung werden auf dem Tabellenblatt "Schlüsselnummern" in Zeile 2 von Spalte A bis EA Daten gespeichert. Diese Daten möchte ich nun beim Speichern der Anwendung in eine Datenbank / Excelblatt "November" auf dem Laufwerk H übertragen. Diese Datenbank ist normalerweise geschlossen. Also müsste diese dann beim Speichern der Anwendung erst geöffnet und dann wieder geschlossen werden. Jetzt könnten allerdings im schlimmsten Fall mehrere Anwender beim Speichern zeitgleich auf diese Datenbank zu greifen. Kann oder wird es hierbei zu Konflikten kommen? Dann würde ich auch gerne beim Speichern der Anwendung eine Abfrage über die Datenbank laufen lassen, ob der Datensatz vorhanden ist und wenn ja, dann diesen Überschreiben. Ansonsten die Daten in der nächsten freien Zeile schreiben. Die Datensätze sind über eine Vertragsnummer in Spalte A eindeutig identifizierbar.
Schon mal Danke fürs Lesen :-) und Meinungen bzw. Lösungsansätze sind erwünscht.
Markus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Markus,
das Problem, dass evtl. 2 Personen gleichzeitig die Speichernaktion versuchen kann man nur bedingt umschiffen. Wenn es nicht zu viele Daten sind, dann dauert der Speichervorgang ja nur 1 bis 2 paar Sekunden.
Ansonsten ist es relativ einfach, die Daten zu speichern. Man kann das Ereignismakro Workbook_BeforeSave nutzen um den Datentransfer zu realiseren.
Nachfolgend ein Beispielmakro.
Gruß
Franz

'###                   Prozedur in DieseArbeitsmappe            ###
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wbAktiv As Workbook, wbZentral As Workbook, strZentral As String
Dim wksDaten As Worksheet, wksZiel As Worksheet
Dim Spalte As Long, Zeile As Long
Dim varSchluessel, ZelleSchluessel As Range, ZeileZiel As Long
'Name der Datenbank-Datei
strZentral = "H:\Verzeichnis\ZentralDatei.XLS"
'strZentral = "C:\Users\Public\Test\ZentralDatei.XLS"
'Aktive Datei merken
Set wbAktiv = ActiveWorkbook
'Tabellenblatt mit Daten in aktiver Datei setzen
Set wksDaten = wbAktiv.Worksheets("Schlüsselnamen")
'Zentrale Datenbank - öffnen
Application.ScreenUpdating = False
Set wbZentral = Application.Workbooks.Open(Filename:=strZentral)
If wbZentral.ReadOnly = True Then
Cancel = True
wbZentral.Close savechanges:=False
Application.ScreenUpdating = True
MsgBox "Die Datei """ & strZentral & """ ist momentan in Benutzung." & vbLf _
& "Bitte später versuchen zu speichern."
Else
'Zielblatt setzen
Set wksZiel = wbZentral.Worksheets("November")
'Vertragsnummer in Spalte 1 in der Daten-Datei abarbeiten
With wksDaten
'      For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Column
Zeile = 2 'Zeile mit den zu übertragenden Daten
varSchluessel = .Cells(Zeile, 1).Value
'In Zielblatt Spalte 1 (A) die Vertragsnummer suchen
With wksZiel
Set ZelleSchluessel = .Columns(1).Find(What:=varSchluessel, LookIn:=xlValues, _
lookat:=xlWhole)
If ZelleSchluessel Is Nothing Then
'Schlüssel noch nicht vorhanden, nächste freie Zeile in Spalte 1 mit Schlüsseln
ZeileZiel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Else
ZeileZiel = ZelleSchluessel.Row
End If
End With
'Daten nach Ziel übertragen
.Range(.Cells(Zeile, 1), .Cells(Zeile, 131)).Copy _
Destination:=wksZiel.Cells(ZeileZiel, 1)
'      Next
End With
'Zentrale Datei speichern und  wieder schließen
wbZentral.Save
wbZentral.Close
Application.ScreenUpdating = False
End If
End Sub

Private Sub CommandButton1_Click() Application.ScreenUpdating = False If Range("I27") = "2" Then ActiveSheet.PrintOut Else MsgBox "Bitte Scorebogen vervollständigen! Scorebogen wurde NICHT gespeichert und _ ausgedruckt!" Exit Sub End If ActiveWorkbook.SaveAs Filename:="H:\Scoring - Privatkunden\Privatkundenscoring\" & Range("K2") & _ "\" _ & Range("B4") & Range("D4") & ".XLS" Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Beim Speichern Daten übertragen

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread