append records in a table from recordset

[remigio]

Ciao,
I have the code below that sends email from access:

Dim db As Database, RS As Recordset
Set db = CurrentDb
Set RS = db.OpenRecordset("prova", dbOpenDynaset)
' q_invio_email

If RS.RecordCount = 0 Then
MsgBox "Nessun messaggio da inviare!" & vbCrLf _
& "Probabilmente non sono stati selezionati i medici curanti nella richiesta " _
& "o sono state valutate solo proroghe."
Exit Sub
End If

'istruzioni per il conteggio dei record
RS.MoveLast
rstotale = RS.RecordCount

'msgbox per procedere con l'invio
msg = MsgBox("Si desidera inviare " & rstotale & " messaggi email relativi all'esito della seduta del " _
& RS!data_valutazione, vbYesNo)
If msg = vbNo Then
Exit Sub
Else


' Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
' Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM

' Da qui comincia il ciclo
RS.MoveFirst
Do Until RS.EOF

Set objmessage = CreateObject("CDO.Message")


objmessage.BodyPart.Charset = "utf-8"
objmessage.Subject = "Seduta U. V. M. del " & RS!data_valutazione
objmessage.From = """PUA NOD di xxx"" <prova@prova.it>"
objmessage.To = RS!EMail
objmessage.TextBody = "Gentile dott. " & RS!cognomenome & "," & vbCrLf _
& "in data " & RS!data_valutazione _
& " si è riunita l'Unità di Valutazione Multidimensionale (UVM) di xxx" _
& "che ha esaminato la Sua richiesta riferita al paziente " & RS!Cognome & " " & RS!Nome _
& " con il seguente esito: " & vbCrLf & Chr(34) & RS!esito & Chr(34) & "." & vbCrLf _
& "Pertanto la S. V. è invitata a dare seguito, per competenza, nel più breve tempo possibile, " _
& "considerati i termini previsti dal DCA n. 107/13." & vbCrLf _
& "Cordiali Saluti" & vbCrLf & vbCrLf _
& "Il PUA del NOD di xxxx"

'==This section provides the configuration information for the remote SMTP server.

objmessage.Configuration.Fields.Item _
(".../sendusing") = 2

'Name or IP of Remote SMTP Server
objmessage.Configuration.Fields.Item _
("...") = "smtp.miosmtp.it"

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objmessage.Configuration.Fields.Item _
(".../smtpauthenticate") = cdoBasic

'Your UserID on the SMTP server
objmessage.Configuration.Fields.Item _
("..../sendusername") = "miamail@miosito.it"

'Your password on the SMTP server
objmessage.Configuration.Fields.Item _
("..../sendpassword") = "password"

'Server port (typically 25)
objmessage.Configuration.Fields.Item _
("..../smtpserverport") = 25

'Use SSL for the connection (False or True)
objmessage.Configuration.Fields.Item _
(".../smtpusessl") = False

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objmessage.Configuration.Fields.Item _
("..../smtpconnectiontimeout") = 30

objmessage.Configuration.Fields.Update

'==End remote SMTP server configuration section==

' invio del messaggio
objmessage.Send

' accoda il record corrente nella tabella pua_email_inviate per il controllo successivo
DoCmd.RunSQL "INSERT INTO pua_email_inviate SELECT cognomenome,email from rs"

RS.MoveNext
Loop
End If

MsgBox "Inviati " & rstotale & " messaggi email!"

RS.Close
Set RS = Nothing
Set db = Nothing



I created a table pua_email_inviate where I want to append each current record is sending via mail, then I added that rows as in the code:


' accoda il record corrente nella tabella pua_email_inviate per il controllo successivo
DoCmd.RunSQL "INSERT INTO pua_email_inviate SELECT cognomenome,email from rs"

but it doesn't append because I don't know how to identify the current record in the code (I putted From rs but it's wrong)
Everything else works fine.
Can you help me please?
Regards


__
Remigio

 

[namliam]

First ... Please use the code wraps to post your code

Second ... Please use the code wraps to post your code

Third ... see the first

Does your table prova have a primary key? if so you can use a ppseudo code:

 ... select from prova where rs.key = " & rs.YourKey

If you dont, you are screwed and probably best off adding a Unique autonumber just for this purpose.

If you cant do that for what ever reason, you will have to resort to something like:

   ... near the top, near set rs = 
   set rs2 = ... "pua_email"
   ... other normal code
   rs2.addnew
   rs2!ThisField = rs.Thisfield
   ....
   rs2.update
   ...
   rs.movenext