Hallo,
hier ein Beispiel, wie ich von Access in Notes schreibe...
On Error GoTo FehlerH
Rem Verrechnung
Rem Notes
Dim session As Object
Dim dbNotes As Object
Dim view As Object
Dim doc As Object
Dim Item As Object
Dim Profile As Object
Dim userName As Object
Dim userVerRName As Object
Set session = CreateObject("Notes.NOTESSESSION")
Rem Server
Set dbNotes = session.GetDatabase("Servername...", "Pfad..")
Rem Kontrolle Verrechnung
Dim PersVerR As String
Set Profile = dbNotes.GetProfileDocument("Profile_Pro")
PersVerR = Profile.GetFirstItem("PersVerR").Text
If PersVerR = "" Then
MsgBox "Achtung: in Profildocument der ProjektDB fehlt bei Verrechnung die Person!", vbExclamation, "Raiffeisen"
Exit Sub
End If
Rem Kontrolle in ProjektDB, ob User berechtigt ist die Verrechnung zu starten
Rem User
Set userName = session.CreateName(session.userName)
Rem berechtigte Person
Set userVerRName = session.CreateName(PersVerR)
If userName.canonical <> PersVerR Then
MsgBox "Sie sind nicht berechtigt die Verrechnung durchzuführen!" & vbCrLf & vbCrLf & "Berechtigte Person: '" & userVerRName.common & "'", vbExclamation, "Raiffeisen"
Exit Sub
End If
SendKeys "{RIGHT}"
If MsgBox("Hiermit werden alle gewählten Projekte in der Projektdatenbank in Lotus Notes als 'VERRECHNET' gekennzeichnet." & Chr(13) & Chr(13) & "Verrechnung starten?", vbYesNo + vbQuestion, "Verrechnung") = vbNo Then
Exit Sub
End If
Rem Schleife über alle Tagesaufwände
Dim db As Database, rs As Recordset
Dim MaxRec As Long, countrec As Long, Rückgabewert As String, NotAkt As Long
Set db = CurrentDb()
Dim rsGroup As Recordset, sql As String
Dim rsDetail As Recordset
Dim rsTag As Recordset
Dim Kriterium As String
Set rsDetail = db.OpenRecordset("Th_AuswPro", DB_OPEN_SNAPSHOT)
Rem Kontrolle Daten vorhanden
If rsDetail.RecordCount = 0 Then
MsgBox "Keine Daten für Verrechnung vorhanden!", vbExclamation, "Raiffeisen"
Exit Sub
Else
rsDetail.MoveLast
MaxRec = rsDetail.RecordCount
rsDetail.MoveFirst
End If
Rem Alle Zeilen von Gruppe
sql = "SELECT Th_AuswProGroup.*"
sql = sql & " FROM Th_AuswProGroup"
sql = sql & " WHERE (((Th_AuswProGroup.TagRechNeu) <> ""Später""))"
sql = sql & " ORDER BY Th_AuswProGroup.ProAnwendung, Th_AuswProGroup.ProName, Th_AuswProGroup.TagRech, Th_AuswProGroup.RisF, Th_AuswProGroup.TagAuftragG;"
Set rsGroup = db.OpenRecordset(sql, DB_OPEN_SNAPSHOT)
Rem Kontrolle Daten vorhanden
If rsGroup.RecordCount = 0 Then
MsgBox "Keine Daten für Verrechnung vorhanden!", vbExclamation, "Raiffeisen"
Exit Sub
End If
Rem in Tabelle T_Tag wird nun DatRech und TagRech aktualisiert
Set rsTag = db.OpenRecordset("T_Tag", DB_OPEN_DYNASET)
Rem Anzhal Rec insgesamt
countrec = 0
Rem Anzahl der nicht gefundenen Tagesaufwände
NotAkt = 0
Rem Nun werden von jeder Gruppenzeilen die Detailzeilen gesucht und mit Anzahl bei Gruppe verglichen
Do Until rsGroup.EOF
Rem Detailzeilen werden gesucht über Kriterium:
sql = "SELECT Th_AuswPro.*"
sql = sql & " FROM Th_AuswPro"
sql = sql & " WHERE (((Th_AuswPro.ProID)" & StringOrNull(rsGroup!ProID) & ") AND ((Th_AuswPro.TagRech)" & StringOrNull(rsGroup!TagRech) & ") AND ((Th_AuswPro.RisF)" & StringOrNull(rsGroup!RisF) & ") AND ((Th_AuswPro.TagAuftragG)" & StringOrNull(rsGroup!TagAuftragG) & ") AND ((Th_AuswPro.ProArt)" & StringOrNull(rsGroup!ProArt) & ") AND ((Th_AuswPro.ProStatus)" & StringOrNull(rsGroup!ProStatus) & "));"
Set rsDetail = db.OpenRecordset(sql, DB_OPEN_DYNASET)
Rem Kontrolle Anzahl Gruppe - Detail
If rsDetail.RecordCount <> rsGroup!AnzahlRec Then
MsgBox "Fataler Fehler! Anzahl Detaildatensätze(" & rsDetail.RecordCount & ") verschieden von Anzahl Gruppe(" & rsGroup!AnzahlRec & ")!", vbExclamation, "Raiffeisen"
Exit Sub
Else
Rem MsgBox rsDetail.RecordCount & " - " & rsGroup!AnzahlRec
End If
Do Until rsDetail.EOF
Rem Nun werden Daten in Notes Aktualisiert
countrec = countrec + 1
Rem Access
Rem in Tabelle T_Tag wird nun DatRech und TagRech aktualisiert
Kriterium = ""
Kriterium = "[TagID]=" & Chr(34) & CStr(rsDetail!TagID) & Chr(34)
rsTag.FindFirst Kriterium
If rsTag.NoMatch Then
MsgBox "Fataler Fehler TagID in Tabelle T_Tag nicht gefunden - " & CStr(rsDetail!TagID)
Exit Sub
Else
Rem Kontrolle ID
If rsDetail!TagID <> rsTag!TagID Then
MsgBox "Fataler Fehler! ID von T_Tag und von rsDetail sind verschieden"
Exit Sub
End If
Rem Kontrolle Flag TagRechNeu in Th_AuswProGroup
If rsGroup!TagRechNeu <> "Ja" And rsGroup!TagRechNeu <> "Nein" And rsGroup!TagRechNeu <> "Später" Then
MsgBox "Fataler Fehler! Falsches Kennzeichen in rsGroup - TagRechNeu - " & rsGroup!TagRechNeu & " - ProID: " & CStr(rsGroup!ProID)
Exit Sub
End If
Rem Kontrolle Flag TagRech in Th_AuswPro
If rsDetail!TagRech <> "Ja" And rsDetail!TagRech <> "Nein" Then
MsgBox "Fataler Fehler! Falsches Kennzeichen in rsDetail - TagRech - " & rsDetail!TagRech & " - TagID: " & CStr(rsDetail!TagID)
Exit Sub
End If
Rem TagRech von T_Tag und rsDetail mup identisch sein
If rsDetail!TagRech <> rsTag!TagRech Then
MsgBox "Fataler Fehler! TagRech in T_Tag und rsDetail unterschiedlich - darf nicht sein" & rsDetail!TagRech & " - " & rsTag!TagRech & " - TagID: " & CStr(rsDetail!TagID)
Exit Sub
End If
If rsGroup!TagRechNeu = "Ja" Or rsGroup!TagRechNeu = "Nein" Then
Rem Zugriff auf Notes
Rem Tagesaufwand in Projektdb wird gesucht
Rem Wird gemacht, weil es vorkommen kann, daß es in der ProDB bestimmte IDs nicht mehr gibt - weil sie eben gelöscht wurden - in der Regel kommt das nicht vor
Set doc = Nothing
Set doc = dbNotes.GetDocumentByUNID(CStr(rsDetail!TagID))
If Not (doc Is Nothing) Then
Rem Sofern auf Fom TagRechNeu geändert wird, so muß das in T_Tag und in Notes geschrieben werden
rsTag.Edit
If rsTag!TagRech <> rsGroup!TagRechNeu Then
Rem Access
Rem Alter Wert wird in OlD Feld geschrieben
rsTag!TagRechOLD = rsTag!TagRech
rsTag!TagRech = rsGroup!TagRechNeu
Rem Notes
Set Item = doc.ReplaceItemValue("TagRech", CStr(rsTag!TagRech))
Set Item = doc.ReplaceItemValue("TagRechOLD", CStr(rsTag!TagRechOLD))
End If
Rem Access
Rem Datum wird immer geschrieben
rsTag!DATRECH = CDate(Format(Now, "dd.mm.yyyy"))
rsTag.Update
Rem Notes
Rem Felder werden geschrieben
Rem Verrechnungsdatum
Set Item = doc.ReplaceItemValue("DatRech", CDate(rsTag!DATRECH))
Rem Neu + + + + + + 10.01.2003
Rem Stundensatz und Betrag wird geschrieben
Set Item = doc.ReplaceItemValue("ResStSatz", CDbl(rsTag!ResStSatz))
Set Item = doc.ReplaceItemValue("Betrag", CDbl(rsTag!Betrag))
Rem Neu + + + + + + 10.01.2003
Call doc.Save(True, False)
End If
ElseIf rsGroup!TagRechNeu = "Später" Then
Rem in diesem Fall wird nichts gemacht
Else
MsgBox "Fehler in rsgroup - TagRechNeu - neuers Kennzeichen - " & rsGroup!TagRechNeu
Exit Sub
End If
End If
Rem Statuszeile
Rückgabewert = SysCmd(SYSCMD_INITMETER, "Daten werden auf Notes aktualisiert: " & CStr(MaxRec - countrec), MaxRec)
Rückgabewert = SysCmd(SYSCMD_UPDATEMETER, countrec)
rsDetail.MoveNext
Loop
rsGroup.MoveNext
Loop
Rem Form wird neu berechnet
Me!Schaltfläche0.SetFocus
Call Akt_FormAuswPro("")
MsgBox "Daten auf Notes erfolgreich aktualisiert!", vbExclamation, "Gesamtanzahl Tagesaufwände: " & countrec & "; nicht gefundene Tagesaufwände: " & NotAkt
Rückgabewert = SysCmd(SYSCMD_SETSTATUS, " ")
Exit Sub
Thema: Von Excel oder Acces in ein Feld (Gelesen 1074 mal)