Anderes Programm aufs Formular legen, damit Textfeld beschieben wird

[Salvation]

Hi,

ich habe die Aufgabe, ein Programm zu schrieben, welches dem User die Arbeit erleichtert. In diesem Programm soll eine E-Mail Adresse generiert werden. Mit dem folgenden Quellcode klappt dies auch:

Code [Auswählen] Erweitern

Private Sub EmailGen_Click()
' für die Original-Tabelle
Dim quellRS As Recordset

' für die neue Tabelle
Dim zielRS As Recordset

' Hilfsvariable für die eindeutige Bezeichnung aus der die Logins und eMail-Adresse generiert werden kann
Dim eindeutig As String

' Hilfsvariablen für die Schleife
Dim nameVorhanden As Boolean
Dim mutation As String

' Variablen um die Tabelle anzusprechen                                                               
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim lngStore As String

' Variablen fürs Mail-generien
Dim strVornamen As String
Dim strNachname As String

' Tabelle aansprechen
Set db = CurrentDb
Set qdf = db.QueryDefs("Abfrage1")
    qdf.Parameters!qryPersNr = PersNr
    qdf.Execute
    qdf.Close: Set qdf = Nothing
Set db = Nothing

'Bookmarksetzen
    lngStore = Me!PersNr

'Bildschirmflackern reduzieren
    Me.Painting = False

'Aktualisieren (Refresh)
    Me.Requery

'Zurück zum Bookmark
    Me.RecordsetClone.FindFirst "PersNr = '" & lngStore & "'"
    Me.Bookmark = Me.RecordsetClone.Bookmark
 
    DoEvents
                                                             
' Als erstes Normal versuchen
mutation = 1

' Nicht Eindeutig bis das Gegenteil bewiesen ist
nameEindeutig = False
                                                               
' Solange wie der Name nicht eindeutig ist
Do While Not nameEindeutig
                                                               
' Erster Versuch: 1. Buchstabe Vorname und Nachname
If mutation = 1 Then
eindeutig = Left(LCase(Forms!fmHaupt!Vorname), 1) & "." & LCase(Forms!fmHaupt!Name)
EMail = eindeutig & "@klinikum-emden.de"
End If

' Zweiter Versuch: Voller Vorname und Nachname
If mutation = 2 Then
eindeutig = Left(LCase(Forms!fmHaupt!Vorname), 2) & "." & LCase(Forms!fmHaupt!Name)
EMail = eindeutig & "@klinikum-emden.de"
End If
                                                               
' Alle anderen Versuche: Mit Zahl dahinter
If mutation >= 3 Then
eindeutig = Left(LCase(Forms!fmHaupt!Vorname), 1) & "." & LCase(Forms!fmHaupt!Name) & (mutation - 1)
EMail = eindeutig & "@klinikum-emden.de"
End If
                                                               
' Nr für den nächsten Versuch festlegen
mutation = mutation + 1

' Gibts schon ??
strSQL = "select count(*) as anzahl from tbITerweitert where " & _
" eMail = '" & EMail & "'"

Set zielRS = CurrentDb().OpenRecordset(strSQL)
zielRS.MoveFirst
                                                               
' Wenn ja, dann nicht Eindeutig
If (zielRS!anzahl > 0) Then
nameEindeutig = False
' Sonst Eindeutig
Else
nameEindeutig = True
End If
                                                               
Loop
' Aus diesem Loop kommt auf jeden Fall ein eindeutiger Name heraus

' Updaten
strSQL = "update tbITerweitert set eMail='" & EMail & "'," & _
"where PersNr = " & PersNr
                                                             
' Nichts zum Updaten da, also Neu anlegen
If CurrentDb.RecordsAffected = 0 Then
strSQL = "insert into tbITerweitert (PersNr, EMail,) " & _
"              values (" & PersNr & ",'" & EMail & "')"

End If
                                                             
End Sub


Ich kann damit ausschließen, dass es doppelte Einträge gibt. Das Programm läuft so auch, nur gibt es ein kleines Problem.

Ich klicke den Button an und das Programm läuft ab. Doch im Textfeld erscheind nichts. Erst wenn ich ein anderes Fenster, z.B. den IE über mein Formular lege, erscheint die generierte E-Mail. Ich möchte jedoch, dass diese gleich nach dem anklicken des Buttoms erscheint.

Ich hab versucht, ob ichs mit einem weiteren Requery hinbekomme. Verarbeitet wird das Requery, jedoch bleibt auch dabei das Textfeld leer.

Gibt es eine Möglichkeit, dass es sofort im Textfeld erscheint?

Danke schonmal im Vorraus.

Salvation

[DF6GL]

Hallo,

setz mal  Me.Painting wieder auf True.


wobei ich meine Zweifel habe, ob der Code wirklich läuft...  Es gibt da viele Ungereimtheiten..

Hast Du den schon mal kompiliert?

[Salvation]

Hi DF6GL,

es funktioniert. Ich sag ja, irgendwo ist immer ein 'doofer' Fehler und man selbst ist Blind, ihn zu finden.

Aber wenn dus schon anschneidest, das es ungereimtheiten gibt, vielleicht magst du mir auch sagen wo? Ich bin für jeden Vorschlag, der das Programm verbessert, vereeinfacht, etc. dankbar.

Zum kompilieren: Ich klick den Button an, hinter dem der Code liegt und er spuckt mir das Ergebnis dann aus. Wie vorher schon geschrieben, läuft er ja. Er gibt es auss, hat aber eben das Problem, dass ich ein anderes Fenster drüber legen musste, damit ers anzeigt.

LG Reaver

[DF6GL]

Hallo,


naja,  der Generierungs"algorithmus" könnte verbessert werden.
ansonsten die Ungereimtheiten/Unzulänglichkeiten:

Private Sub EmailGen_Click()

Dim mutation As Long
Dim db As DAO.Database
Dim strEMail as String




' für die Original-Tabelle
Dim quellRS As Dao.Recordset
' für die neue Tabelle
Dim zielRS As DAO.Recordset

' Hilfsvariable für die eindeutige Bezeichnung aus der die Logins und eMail-Adresse generiert werden kann
Dim nameEindeutig As Boolean
' Hilfsvariablen für die Schleife
Dim nameVorhanden As Boolean


Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim strStore As String  ' if Fall , dass PersNr in der Tabelle vom Datentyp TEXT ist

' Variablen fürs Mail-generien
Dim strVornamen As String
Dim strNachname As String




Set db = CurrentDb

' Tabelle ansprechen
Set qdf = db.QueryDefs("Abfrage1")  
   qdf.Parameters!qryPersNr = PersNr
   qdf.Execute   'Was macht diese Aktionsabfrage?
  qdf.Close: Set qdf = Nothing
Set db = Nothing    'db wird später noch gebaraucht.


'Bildschirmflackern reduzieren
   Me.Painting = False    'Was sollte flackern?

'Bookmarksetzen
   strStore = Me!PersNr

'Aktualisieren (Refresh) 'Warum?

  Me.Requery     '  Besser : Me.Refresh falls wirklich nötig..







'Zurück zum Bookmark   ' Warum?, Wir waren nie woanders.
  Me.RecordsetClone.FindFirst "PersNr = '" & strStore & "'"
   Me.Bookmark = Me.RecordsetClone.Bookmark
   


 DoEvents                 ' vermutlich überflüssig    




                                     
' Als erstes Normal versuchen
mutation = 1

' Nicht Eindeutig bis das Gegenteil bewiesen ist
nameEindeutig = False



mutation=0            
                                                 
' Solange wie der Name nicht eindeutig ist
Do Until  mutation=10  '12 Versuche max.                                                                
' Erster Versuch: 1. Buchstabe Vorname und Nachname
If mutation =0 then
strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name])
strEMail = strEMail  & "@klinikum-emden.de"
If Dcount("*","tbITerweitert", "Email='" & strEMail & "'") = 0 then Exit Do

strEMail  = Left(LCase(Me!Vorname), 2) & "." & LCase(Me![Name])
strEMail = EMail  & "@klinikum-emden.de"
If Dcount("*","tbITerweitert", "Email='" & strEMail & "'") = 0 then Exit Do

end If


mutation = mutation + 1

strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name]) & mutation
strEMail = strEMail & "@klinikum-emden.de"
If Dcount("*","tbITerweitert", "Email='" & strEMail & "'") = 0 then Exit Do  
                                                           
Loop


' Updaten
strSQL = "update tbITerweitert set eMail='" & strEMail & "'," & _
" where PersNr = '" & PersNr & "'"      ' auf Datentyp achten


db.Execute strSQL   ' wenn schon, dann auch wirklich ausführen?
                                                         
' Nichts zum Updaten da, also Neu anlegen
If Db.RecordsAffected = 0 Then   'Currentdb.Recordsaffected brächte immer 0
strSQL = "insert into tbITerweitert (PersNr, EMail,) " & _
"              values ('" & PersNr & "','" & strEMail & "')"    ' auf Datentyp achten
End If
   


Me.Refresh  ' unklar ist, auf welcher Tabelle das Formular basiert und welche Bedeutung tblTerweitert hat  

set db=Nothing  'hier db zerstören                                                          
End Sub


(unchecked)

[Salvation]

Hi,

okay, es fehlte nur ein End If

Ich lege ja E-Mail, Benutzername und BenutzernameOrbis an. Wenn ich Benutzernamen schon angelegt habe, dann generiert man mir die E-Mail ohne Probleme. Wenn ich aber mit der E-Mail nun anfange, gibt es eine Fehlermeldung.

Code [Auswählen] Erweitern

(Laufzeitfehler '-2147352567 (80020009)'
Es kann kein Wert in ein leeres Feld auf der '1'-Seite einer Inklusionsverknüpfung eingegeben werden.
Makiert wird dabei folgender Codeteil:

Code [Auswählen] Erweitern

EMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name])




Die Fehlermeldung hatten wir schonmal und wurde durch diesen Code:

Code [Auswählen] Erweitern

'Tabelle ansprechen
Set db = CurrentDb
Set qdf = db.QueryDefs("Abfrage1")
    qdf.Parameters!qryPersNr = PersNr
    qdf.Execute
    qdf.Close: Set qdf = Nothing
Set db = Nothing

aufgehoben. Denn hat damals mein Chef reingeschrieben, damit die PersNr übergeben wird und man danach generieren kann. Vorher war dies nicht möglich.


So wie ich nun in der tbITerweitert gesehen habe, schiebt das Programm die PersNr rüber, aber scheind danach nicht weiter zu kommen, so dass die E-Mail auch übergeben wird.

Im Anhang habe ich mal die beiden Tabellen angehängt. Sie müssen getrennt bleiben, da die Tabelle Haupt Daten beinhaltet, welche aus einer weiteren Access Datenbank exportiert werden. Diese ist eigentlich umfassender, wurde auf das gekürzt, was für mein Programm benötigt wird. So soll mit verhindert werden, dass irgendjemand an den Daten was ändern kann.


LG Salvation

[Anhang gelöscht durch Administrator]

[DF6GL]

Hallo,


vermutlich ist "Email" ein Formularfeld. Wenn die Form-Referenz ("Me") weggelassen wird, ist das im Code nicht zu erkennen.  (Ich habe allerdings übersehen,die Deklaration der Variablen "EMail" zu machen).

Also füge diese Codezeile noch hinzu:


Dim strEMail as String

und ändere alle vorkommenden  Variablen(!) -Namen (nicht! den Tabellenfeldnamen im SQL-String) entsprechend ab.


Siehe den korrigierten Code im meinem letzten Post.

[Salvation]

Hi,

ich habe die Deklaration eingefügt und - ich hoffe richtig - die Namen angepasst.

Nun wurd jedoch weder die PersNr übertragen, noch etwas generiert. Es tut sich nichts.

Durch MsgBox hab ich mal geschaut, bis wo das Programm durchgelaufen wird. Es werden mir die MsgBox'en 1, 5 und 6 angezeigt. (Ich kopiere den Code gleich rein) Irgendwie kommt er zwar in die Schleife, läuft nun aber nicht den Ersten Versuch durch. Ich kann mich auch irren. Aber wenn der erster Versuch nicht angestoßen wird, dann kann er auch nichts bekommen und dies anzeigen.

Code [Auswählen] Erweitern

Private Sub EmailGen_Click()
Dim mutation As Long
Dim db As DAO.Database
Dim strEMail As String

Set db = CurrentDb

'Aktualisieren (Refresh) Warum?
Me.Refresh
                                                         
mutation = 0

MsgBox "1"

' Solange wie der Name nicht eindeutig ist
Do Until mutation = 10 '12 Versuche max.

' Erster Versuch: 1. Buchstabe Vorname und Nachname
If mutation = 0 Then
strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name])
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tbITerweitert", "Email='" & EMail & "'") = 0 Then Exit Do

MsgBox "2"

' Zeiter Versuch: 1. & 2. Buchstabe Vorname und Nachname
strEMail = Left(LCase(Me!Vorname), 2) & "." & LCase(Me![Name])
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tbITerweitert", "Email='" & EMail & "'") = 0 Then Exit Do

MsgBox "3"

mutation = mutation + 1

' Driter Versuch: 1. Buchstabe Vorname, Nachname und eine Zahl
strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name]) & mutation
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tbITerweitert", "Email='" & EMail & "'") = 0 Then Exit Do
End If

MsgBox "4"

Loop

' Updaten
strSQL = "update tbITerweitert set EMail='" & EMail & "'," & _
" where PersNr = '" & PersNr & "'"      ' auf Datentyp achten

MsgBox "5"

'db.Execute strSQL   ' wenn schon, dann auch wirklich ausführen?
                                                           
' Nichts zum Updaten da, also Neu anlegen
If db.RecordsAffected = 0 Then   'Currentdb.Recordsaffected brächte immer 0
strSQL = "insert into tbITerweitert (PersNr, EMail,) " & _
"              values ('" & PersNr & "','" & EMail & "')"    ' auf Datentyp achten
End If

MsgBox "6"

Me.Refresh  ' unklar ist, auf welcher Tabelle das Formular basiert und welche Bedeutung tblTerweitert hat

Set db = Nothing 'hier db zerstören
End Sub



Ach ja, db.Execute strSQL hab ich auch auskommentiert. Wenn ich diesen stehen lasse, gibt es Fehlermeldung, dass in der Syntax vom Update was nicht stimmt.

LG Salvation


PS: Ich hoffe ich habe dich wirklich richtig verstanden, und die richtigen Stellen mit strEMail angepasst. Ansonsten Asche auf mein Haupt

[DF6GL]

Hallo,


vermutlich war ich vorhin noch beim Ändern meines "Code"_Posts und Du hast ein Zwischending erwischt.

hier nochmal der Code (auch wieder unchecked)


Private Sub EmailGen_Click()
Dim mutation As Long
Dim db As DAO.Database
Dim strEMail As String

Set db = CurrentDb

'Aktualisieren (Refresh) Warum?
Me.Refresh
                                                       
mutation = 0

MsgBox "1"

' Solange wie der Name nicht eindeutig ist
Do Until mutation = 10 '12 Versuche max.

' Erster Versuch: 1. Buchstabe Vorname und Nachname
If mutation = 0 Then
strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name])
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tbITerweitert", "Email='" & strEMail & "'") = 0 Then Exit Do

MsgBox "2"

' Zeiter Versuch: 1. & 2. Buchstabe Vorname und Nachname
strEMail = Left(LCase(Me!Vorname), 2) & "." & LCase(Me![Name])
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tbITerweitert", "Email='" & strEMail & "'") = 0 Then Exit Do

End If

MsgBox "3"

mutation = mutation + 1

' Driter Versuch: 1. Buchstabe Vorname, Nachname und eine Zahl
strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name]) & mutation
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tbITerweitert", "Email='" & strEMail & "'") = 0 Then Exit Do
End If

MsgBox "4"

Loop

' Updaten
strSQL = "update tbITerweitert set EMail='" & strEMail & "'  " & _   'hier war ein Komma zuviel
" where PersNr = '" & PersNr & "'"      ' auf Datentyp achten

MsgBox "5"

db.Execute strSQL   ' wenn schon, dann auch wirklich ausführen?
                                                         
' Nichts zum Updaten da, also Neu anlegen
If db.RecordsAffected = 0 Then   'Currentdb.Recordsaffected brächte immer 0
strSQL = "insert into tbITerweitert (PersNr, EMail) " & _   'Hier war auch ein Komma zuviel
"              values ('" & PersNr & "','" & strEMail & "')"    ' auf Datentyp achten
End If

MsgBox "6"

Me.Refresh  ' unklar ist, auf welcher Tabelle das Formular basiert und welche Bedeutung tblTerweitert hat

Set db = Nothing 'hier db zerstören
End Sub

[Salvation]

Hi,

der Fehler bleibt, dass er wohl nicht in den ersten Versuch kommt. Eben hatte ich eine PersNr schon von vorhin drine stehen, dann generiert er.  Hab dann meine Tabelle tbITerweitert geleert und nochmal versucht, da passiert dann wieder nichts.  Demnach wohl auch das Problem, dass die PersNr nicht übergeben wird.

LG Salvation

[DF6GL]

Hallo,

setz halt mal einen Haltepukt an den Anfang der Prozedur und fahr mit Einzelschritt durch. Prüf dabei den Inhalt der einzelnen Variablen.


Evtl müssen die DCount-Funktionen in nz(...  ,0) eingeschlossen werden.


If nz( DCount("*", "tbITerweitert", "Email='" & strEMail & "'"),0)  = 0 Then Exit Do

[Salvation]

Hi,

das NZ hat nichts gebracht.
Ich hab nun auch mal versucht Haltepunkte zu setzen und schein mich ein wenig doof anzustellen. Da wo ich den Haltepunkt gesetzt habe, hält er an, aber irgenwelche Infos anzeigen?! Wie stellt man dies an? Weil wenn er da stoppt okay, aber so hilft es nicht viel. Vielleicht bin ich auch einfach nur Blind, da ich schon wieder recht lange an dem Code hänge.

Und entschuldige meine nervige Art.

Salvation

[DF6GL]

Hallo,

Du brauchst nur mit dem Cursor auf eine Variable zu gehen und es sollte der akt. Wert angezeigt werden.

Weiterhin kannst Du im Direktfenster einen Variableninhalt anzeigen lassen, wenn vor dem V.-Namen ein Fragezeichen gesetzt wuird:

?strEMail <Return>

das funktioniert auch mit Funktionen:

?DCount("*", "tbITerweitert", "Email='" & strEMail & "'")   <Return>

So, und hier nochmal die Prozedur, die bei mir funktioniert:

Code [Auswählen] Erweitern



Private Sub Befehl4_Click()
Dim mutation As Long
Dim db As DAO.Database
Dim strEMail As String, strSQL As String

Set db = CurrentDb

'Aktualisieren (Refresh) Warum?
Me.Refresh
                                                         
mutation = 0

MsgBox "1"

' Solange wie der Name nicht eindeutig ist
Do Until mutation = 10 '12 Versuche max.

' Erster Versuch: 1. Buchstabe Vorname und Nachname
If mutation = 0 Then
strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name])
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tblTerweitert", "Email='" & strEMail & "'") = 0 Then Exit Do

MsgBox "2"

' Zeiter Versuch: 1. & 2. Buchstabe Vorname und Nachname
strEMail = Left(LCase(Me!Vorname), 2) & "." & LCase(Me![Name])
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tblTerweitert", "Email='" & strEMail & "'") = 0 Then Exit Do

End If

MsgBox "3"

mutation = mutation + 1

' Driter Versuch: 1. Buchstabe Vorname, Nachname und eine Zahl
strEMail = Left(LCase(Me!Vorname), 1) & "." & LCase(Me![Name]) & mutation
strEMail = strEMail & "@klinikum-emden.de"
If DCount("*", "tblTerweitert", "Email='" & strEMail & "'") = 0 Then Exit Do


MsgBox "4"

Loop

' Updaten
strSQL = "update tblTerweitert set EMail='" & strEMail & "'  " & _
" where PersNr = '" & Me!Persnr & "'"      ' auf Datentyp achten

MsgBox "5"

db.Execute strSQL   ' wenn schon, dann auch wirklich ausführen?
                                                           
' Nichts zum Updaten da, also Neu anlegen
If db.RecordsAffected = 0 Then   'Currentdb.Recordsaffected brächte immer 0
strSQL = "insert into tblTerweitert (PersNr, EMail) " & _
"              values ('" & Me!Persnr & "','" & strEMail & "')"    ' auf Datentyp achten
End If
db.Execute strSQL
MsgBox "6"

Me.Refresh  ' unklar ist, auf welcher Tabelle das Formular basiert und welche Bedeutung tblTerweitert hat

Set db = Nothing 'hier db zerstören

End Sub


[Salvation]

Hi,

erstmal vielen lieben Dank für deine Mühe.
Bei mir funktioniert es so, wie es bei dir funktioniert, leider noch nicht. Springt weiterhin von 1 zu 5.
Aber ich werd mal weiter schauen. Irgendwann finde ich sicher den Fehler.
Sollte dir noch was einfallen, immer her damit.

Ansonsten schau ich für den Rest des Tages, was bei mir noch das Problem ist.

Nochmals, Vielen Dank

LG Salvation


Edit:


vielleicht für dich auch noch interessant. Habs eben gesehen.

Hab den Mutationswert beim ersten Versuch von 0 auf 10 geändert, dann kommt er zumindest in die Schleife. Nimmt auch den dritten Versuch mit.
Ausgegeben wird es jedoch nicht im Textfelt, aber in der Tabelle tbITerweitert, wird der generierte Wert gespeichert.

Sag ja, ist sicher irgendwo noch ein kleiner Fehler