AW: Erfassung in Excel, Daten in ACCESS
01.07.2003 17:56:30
ChrisL
Hi Mannfred
Ich habe mal sowas ähnliches gemacht, wobei die Datensätze in eine separate Mappe gespreichert werden. Die erste Datei (Read Only) ist vollständig mit Userforms geführt. Wird der Datensatz abgespeichert, erfolgt der Check ob die Datenbank (XL Mappe) gerade durch einen anderen User in gebrauch ist, evtl. ein paar Sekunden verzögerung, dann öffnen, speichern und gleich wieder schliessen. Die eigentliche Tabelle mit den Daten ist also immer nur für ein paar Sekunden geöffnet und es sollte so eigentlich nicht zur Kollistion kommen.
Allerdings ist dies auch ziemlich aufwändig, konnte aber in meinem Fall nicht auf Access ausweichen. Wenn du gedenkst viel Zeit zu investieren, würde ich dir eher empfehlen das ganze in Access neu aufzusetzten.
Nachstehend ein Auszug... für das Öffnen/Schliessen der zweiten Mappe.
Gruss
Chris
Option Explicit
Public Besetzt As Boolean
Public DBPfad As String
Function DateiIstFrei(ByVal sDateiname As String) As Boolean
'Funktion zur Überpfüfung, ob Datei bereits geöffnet
Dim hFile As Integer
On Error Resume Next
hFile = FreeFile()
Open sDateiname For Random Access Read Lock Read Write As #hFile
If Err Then
DateiIstFrei = False
Else
DateiIstFrei = True
End If
Close #hFile
End Function
Sub schliessen()
Application.Cursor = xlWait
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub
Sub SchliessenOhneSpeicherung()
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.Cursor = xlDefault
End Sub
Sub oeffnen()
Dim newHour As Date, newMinute As Date, newSecond As Date, WaitTime As Date
Dim i As Integer
Application.Cursor = xlWait
Application.ScreenUpdating = False
Besetzt = False
If DateiIstFrei(DBPfad) = True Then
Workbooks.Open DBPfad
Exit Sub
Else
'1. Datei ist besetzt, deshalb 3 Sekunden warten und erneut testen
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3
WaitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait WaitTime
'2. Erneut prüfen, falls besetzt 5 Sekunden warten
If DateiIstFrei(DBPfad) = True Then
Workbooks.Open DBPfad
Exit Sub
Else
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 5
WaitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait WaitTime
'3. Versuch und sonst abbrechen
If DateiIstFrei(DBPfad) = True Then
Workbooks.Open DBPfad
Exit Sub
Else
MsgBox "Fehler: Die Datenbank konnte nicht geöffnet werden, da bereits durch einen anderen User in Bearbeitung."
Application.Cursor = xlDefault
Besetzt = True
Application.ScreenUpdating = True
Exit Sub
End If
End If
End If
End Sub
Sub DB1oeffnen()
DBPfad = Workbooks("CMS.xls").Sheets("Pfad").Cells(2, 2)
Call oeffnen
End Sub
Sub DB2oeffnen()
DBPfad = Workbooks("CMS.xls").Sheets("Pfad").Cells(3, 2)
Call oeffnen
End Sub
Sub DB3oeffnen()
DBPfad = Workbooks("CMS.xls").Sheets("Pfad").Cells(4, 2)
Call oeffnen
End Sub
Sub DB4oeffnen()
DBPfad = Workbooks("CMS.xls").Sheets("Pfad").Cells(5, 2)
Call oeffnen
End Sub