Autor
|
Thema: Daten beim Speichern in Datenbank schreiben (2391 mal gelesen)
|
Bruderlori Mitglied
Beiträge: 11 Registriert: 13.07.2017 Office 2013 Win10 prof.
|
erstellt am: 14. Jul. 2017 21:55 <-- editieren / zitieren --> Unities abgeben:
Hallo Ich möchte Datensätze die seit dem letzten Speichern neu eingegeben werden aus einer Excel Tabelle in eine Access Datenbank schreiben und die Einträge die älter als, sagen wir mal, 3 Wochen sind löscht sobald man die Tabelle speichert. Leider bin ich bei VBA recht blank. Ich bekomme den Code zwar angepasst wenn ich das Grundgerüst habe aber beim neu erstellen bin ich noch nicht wirklich fit. Die Tabelle habe ich als Bild mal angehängt. Übertragen werden soll Spalte A bis M. Die gleichen Spalten gibt es auch in der Access Datenbank. Wenn mir jemand einen Rolling liefern könnte den ich auf meine Bedürfnisse anpassen kann wäre echt super. Momentan habe ich in meiner Tabelle ein Makro laufen was die neu eingegebenen Zellen beim schließen der Tabelle sperrt. Vielleicht kann man das ja erweitern. Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim Merker As Boolean Dim SH As Worksheet Merker = Me.Saved For Each SH In ThisWorkbook.Worksheets SH.Unprotect "passwort" SH.UsedRange.Locked = True On Error Resume Next SH.UsedRange.SpecialCells(xlCellTypeBlanks).Locked = False On Error GoTo 0 SH.Protect "passwort" Next If Merker Then Me.Save End Sub Schon mal vielen Dank für eventuelle Hilfe. Grüße Thomas Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 16. Jul. 2017 11:07 <-- editieren / zitieren --> Unities abgeben: Nur für Bruderlori
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 17. Jul. 2017 16:14 <-- editieren / zitieren --> Unities abgeben: Nur für Bruderlori
Hallo Thomas, Mal auf die Schnelle hier ein Code, der auch in der beiliegenden Exceltabelle eingefügt ist. Habe daheim nur Office 2000 aber der Code funktioniert auch unter Office 2010 Zur Realisierung auf mehreren Arbeitsplätzen müßtest Du entweder überall xlsm - Mappen speichern oder Du erstellst Dir eine xlsa - Mappe mit dem Programm und stellst das Programm als AddIn zur Verfügung. Letzteres ist eindeutig die sinnvollere Variante, da bei Änderungen nur eine Datei geändert werden muß. Bei der Löschabfrage wurde kein besonderer Zeitraum abgefragt. Es werden die Datensätze markiert die bereits in der Datenbank eingetragen sind. Somit hat man immer die zuletzt eingetragenen Datensätze in der Tabelle. Viel Spaß dabei. Klaus Code:
Sub db_Update() Dim Cn As ADODB.Connection Dim rsDaten As ADODB.Recordset Dim rsNeu As ADODB.Recordset Dim sHilf As String Dim strPfad As String Dim strMDB As String Dim strTable As String Dim strSQL As String Dim L As Long, L1 As Long Dim aktR As Long, aktS As Long Dim Result As VbMsgBoxResult strPfad = "D:\Forum\CAD.de\Excel\Bruderlori\" ' <<< Hier Pfad und Datenbankname eintragen strMDB = strPfad & "BDE Daten.mdb" ' Accessdatenbank strTable = "Daten" ' Access-Tabellenname ' <<< Name der Tabelle in der Datenbank Set Cn = New ADODB.Connection Set rsDaten = New ADODB.Recordset Set rsNeu = New ADODB.Recordset On Error GoTo err_erzeugen With Cn #If Win64 Then .Provider = "Microsoft.ACE.OLEDB.12.0" ' ( Windows 8.1 mit Office 2010 #ElseIf Win32 Then .Provider = "Microsoft.Jet.OLEDB.4.0" ' ( Windows XP mit Office 2000 #End If .CursorLocation = adUseClient 'Meistens Cursor auf Client außer für SEHR große Arbeiten ' .Mode = adLockReadOnly ' Sperrungen (hier nur Lesen) .Mode = adModeShareDenyNone ' Sperrungen (hier keine bei Multiuser) .ConnectionString = "Data Source=" & strMDB .Open End With aktR = 2 ' Beginn der Auswertung ab Zeile 2 While Not Cells(aktR, 1) = "" ' Datensatz bereits letztes Mal untersucht? If Cells(aktR, 13) = "J" Then GoTo Next_Row ' Gibt es diesen Datensatz schon? ' Ich bin davon ausgegangen dass ein Mitarbeiter nicht zwei Artikel gleichzeitig untersucht ' deshalb hier nur die Abfrage nach Datum, Start- und Endzeit strSQL = "SELECT " & _ "D.Personalnummer, D.Datum, D.StartZeit, D.EndZeit " & _ " FROM " & strTable & " D" & _ " WHERE (" & _ " D.Personalnummer = " & Cells(aktR, 3) & _ " AND D.Datum = #" & Format(Cells(aktR, 4), "yyyy-mm-dd") & "# " & _ " AND D.StartZeit = #" & Format(Cells(aktR, 5), "hh:mm:ss") & "# " & _ " AND D.EndZeit = #" & Format(Cells(aktR, 6), "hh:mm:ss") & "# " & _ ") " & _ " ;" With rsDaten .ActiveConnection = Cn .CursorLocation = adUseClient .CursorType = adOpenKeyset .LockType = adLockOptimistic .Open strSQL End With If rsDaten.RecordCount > 0 Then ' Datensatz schon vorhanden ' Löschmarkierung setzen Cells(aktR, 13) = "J" Else ' Datensatz ergänzen With rsNeu .ActiveConnection = Cn .CursorLocation = adUseClient .CursorType = adOpenKeyset .LockType = adLockOptimistic .Source = "SELECT * FROM " & strTable .Open .AddNew .Fields("Schichtgruppe") = Cells(aktR, 1) .Fields("Schicht") = Cells(aktR, 2) .Fields("Personalnummer") = Cells(aktR, 3) .Fields("Datum") = Format(Cells(aktR, 4), "yyyy-mm-dd") .Fields("StartZeit") = Format(Cells(aktR, 5), "hh:mm") .Fields("EndZeit") = Format(Cells(aktR, 6), "hh:mm") .Fields("Artikelnummer") = Cells(aktR, 7) .Fields("NIO_Teile") = Cells(aktR, 8) .Fields("IO_Teile") = Cells(aktR, 9) If IsEmpty(Cells(aktR, 10)) Then ' Kann auch weggelassen werden wenn in der Datenbank leere Felder zugelassen sind .Fields("Kontrolle_2") = "" Else .Fields("Kontrolle_2") = Cells(aktR, 10) End If If Not (IsEmpty(Cells(aktR, 11))) Then ' Könnte auch weggelassen werden, dann werden in der Datenbank Nuller geschrieben .Fields("Störzeit") = Cells(aktR, 11) End If If IsEmpty(Cells(aktR, 12)) Then .Fields("Bemerkung") = "" Else .Fields("Bemerkung") = Cells(aktR, 12) End If .Update End With rsNeu.Close End If rsDaten.Close Next_Row: aktR = aktR + 1 Wend Cn.Close Set rsDaten = Nothing Set rsNeu = Nothing Set Cn = Nothing ' Vorhandene Daten löschen Result = MsgBox("Alte Datensätze löschen ?", vbYesNo, "Exceltabelle bereinigen") If Result = vbYes Then For L = aktR - 1 To 2 Step -1 If Cells(L, 13) = "J" Then Rows(L & ":" & L).Delete Shift:=xlUp Next L End If Exit Sub err_erzeugen: MsgBox Err.Number & vbCrLf & Err.Description Stop Resume Next End Sub
[Edit]Fehlerkorrektur im Code : If IsEmpty(Cells(aktR, 11)) Then .Fields("Bemerkung") = "" muß heißen: If IsEmpty(Cells(aktR, 12)) Then .Fields("Bemerkung") = "" [Diese Nachricht wurde von KlaK am 18. Jul. 2017 editiert.] Edit_2: Falsche Zip entfernt [Diese Nachricht wurde von KlaK am 18. Jul. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Bruderlori Mitglied
Beiträge: 11 Registriert: 13.07.2017 Office 2013 Win10 prof.
|
erstellt am: 17. Jul. 2017 18:07 <-- editieren / zitieren --> Unities abgeben:
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 18. Jul. 2017 12:26 <-- editieren / zitieren --> Unities abgeben: Nur für Bruderlori
|
Bruderlori Mitglied
Beiträge: 11 Registriert: 13.07.2017 Office 2013 Win10 prof.
|
erstellt am: 18. Jul. 2017 13:44 <-- editieren / zitieren --> Unities abgeben:
Ich stell mich wohl doch zu blöd an. Probiert habe ich die Dateien im .Zip Ordner. Die zeigen leider gar keine Reaktion. Ich habe beide auf da Format von Office 2013 gebracht und die Pfade angepasst. Leider bleibt es bei stop stehen(siehe Bild). Ich habe auch mal den Code der hier im Forum steht eingefügt. Da kommt leider nur eine Fehlermeldung 3709( siehe Bild) ich probiere es weiter!
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 18. Jul. 2017 14:25 <-- editieren / zitieren --> Unities abgeben: Nur für Bruderlori
|
Bruderlori Mitglied
Beiträge: 11 Registriert: 13.07.2017 Office 2013 Win10 prof.
|
erstellt am: 18. Jul. 2017 17:31 <-- editieren / zitieren --> Unities abgeben:
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 18. Jul. 2017 17:50 <-- editieren / zitieren --> Unities abgeben: Nur für Bruderlori
Welches Format abfragen? Es werden doch nur Werte in das benötigte Format umgewandelt. Wenn Du das bei der ersten SQL-Abfrage meinst (Daten in DB vorhanden): Theoretisch kann man die Formatfunktion auch weglassen wenn die Zellen in Excel richtig formatiert sind. Aber gerade beim Datum habe ich öfters mal die Probleme gehabt dass komische Ergebnisse zurück kamen wenn nicht die amerikanische Datumsangabe übergeben wurde (2017-07-18 statt 18.07.2017). Beim Speichern gab es da nie Probleme, beim Abfragen schon. Habe es mir deshalb angewöhnt immer die Formatierung zu setzen. Das Rautezeichen (##) ist bei SQL-Ausdrücken ebenfalls erforderlich, vergleichbar dem Hochkomma bei Text ("Text") definiert es den Inhalt als Datum-/Zeitwert. Dadurch dass die Werte direkt in die Felder geschrieben werden, entfallen diese Begrenzungszeichen. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Bruderlori Mitglied
Beiträge: 11 Registriert: 13.07.2017 Office 2013 Win10 prof.
|
erstellt am: 24. Jul. 2017 08:22 <-- editieren / zitieren --> Unities abgeben:
Hallo Ich habe die letzten Tage mal ein wenig mit der Datenbank gespielt und die Vorhandenen Datensätze übertragen. Mir ist es ein paar mal passiert das es Datensätze nicht überträgt aber sie als übertragen markiert. Wenn ich es richtig verstanden habe prüft es nur nach Personalnummer Datum startzeit und Endzeit. While Not Cells(aktR, 1) = "" ' Gibt es diesen Datensatz schon? strSQL = "SELECT " & _ "D.Personalnummer, D.Datum, D.StartZeit, D.EndZeit " Kann ich das einfach erweitern? Grüße Thomas Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 24. Jul. 2017 09:45 <-- editieren / zitieren --> Unities abgeben: Nur für Bruderlori
Hallo, natürlich kann man das einfach erweitern: Code:
strSQL = "SELECT " & _ "D.Personalnummer, D.Datum, D.StartZeit, D.EndZeit, D.Schichtgruppe, D.Schicht, D.Artikelnummer " & _ " FROM " & strTable & " D" & _ " WHERE (" & _ " D.Personalnummer = " & trim(Cells(aktR, 3)) & _ " AND D.Datum = #" & Format(Cells(aktR, 4), "yyyy-mm-dd") & "# " & _ " AND D.StartZeit = #" & Format(Cells(aktR, 5), "hh:mm:ss") & "# " & _ " AND D.EndZeit = #" & Format(Cells(aktR, 6), "hh:mm:ss") & "# " & _ " AND D.Schichtgruppe = " & Chr(34) & Cells(aktR, 1) & Chr(34) & _ " AND D.Schicht = " & Chr(34) & Cells(aktR, 2) & Chr(34) & _ " AND D.Artikelnummer = " & Cells(aktR, 7) & _ ") " & _ " ;"
Denn UBB-Code für Fett darfst natürlich nicht in der Abfrage drin haben Gibt es denn einen Hinweis bei welchen Datensätzen dies geschehen ist? Wurden denn dort wirklich von einem Mitarbeiter zur gleichen Zeit verschiedene Artikel geprüft? Wie ist die Personalnummer in der Datenbank definiert? Als Zahl oder Text? Wenn Text dann könnte obige Änderung ( Trim() ) helfen. Aber dann müßte der Wert auch in Hochkomma ( chr(34) ) gesetzt werden Grüße Klaus
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Werkstudent BIM (m/w/d) für API-Programmierungen (Tekla Structures, Inventor) | GOLDBECK?realisiert zukunftsweisende Immobilien in Europa. Wir verstehen Gebäude als Produkte und bieten alle Leistungen aus einer Hand: vom Design über den Bau bis zu Services im Betrieb. Aktuell beschäftigt unser Familienunternehmen mehr als 12.000 Mitarbeitende an über 100 Standorten bei einer?Gesamtleistung von über 6 Mrd. Euro. Unser Anspruch ?building?excellence? steht dabei für Spitzenleistungen ... | Anzeige ansehen | Weitere: IT |
|
KlaK Ehrenmitglied V.I.P. h.c. Dipl. Ing. Vermessung, CAD- und Netz-Admin
Beiträge: 2624 Registriert: 02.05.2006 Office 2010; Office365 Visual Basic
|
erstellt am: 24. Jul. 2017 13:14 <-- editieren / zitieren --> Unities abgeben: Nur für Bruderlori
Zitat: Original erstellt von Bruderlori: Mir ist es ein paar mal passiert das es Datensätze nicht überträgt aber sie als übertragen markiert.
Hallo Thomas, Diesen Satz verstehe ich nicht ganz. Das Programm sucht in der Datenbank ob ein Datensatz vorhanden ist und markiert ihn dann mit in der Exceltabelle mit "J" Neu eingetragene Datensätze werden nicht markiert bzw. erst beim erneuten Durchlauf des Programmes (sind dann ja schon eingetragen worden). Deiner Feststellung nach müßten Datensätze in der Datenbank gefunden werden die gar nicht eingetragen wurden. Das kann eigentlich nur auf einen Eintragsfehler in der Tabelle hinweisen, nach dem Kopieren der Zellen wurden die Werte (Pers.nr, Datum, Anfang, Ende) nicht geändert. Grüße Klaus
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |