body in mail

Status
Niet open voor verdere reacties.

phobia

Terugkerende gebruiker
Lid geworden
4 sep 2006
Berichten
1.777
Dim objMessage, Rcpt

Rcpt = email
Set objMessage = CreateObject("CDO.Message")
objMessage.subject = "Snipper Overzicht"
objMessage.From = """blabla"" me@chello.nl"
objMessage.To = Rcpt
objMessage.HTMLBody = [Naam] & " " & [Achternaam] & "Datum : " & [Datum] & " uren: " & [Uren]

objMessage.Send

met deze code kan ik de body van een mail maken, snap ik. Maar doe kan ik de gegevens van een query of form hier in laten verwerken?
 
Darvoor moet je eerst die gegevens ophalen die je nodig hebt met bijvoorbeeld het statement DLOOKUP, maar als het meerdere gegevens zijn is een recordset vaak een heel stuk sneller.
Voorbeeld DLOOKUP
Code:
Dim strNaam as string
Dim strAdres as string
Dim lngBurgerServiceNummer as long

lngBurgerservicenummer = 1234

strNaam = Dlookup("Naam","tblPersoon","BSN =" & lngBurgerServiceNummer)
strAdres = Dlookup("Adres","tblPersoon","BSN =" & lngBurgerServiceNummer)
Voorbeeld met een snellere recordset:
Code:
dim rst as recordset
dim dbs as database
Dim strNaam as string
Dim strAdres as string
Dim lngBurgerServiceNummer as long

set dbs = currentdb
set rst = dbs.openrecordset("Select Naam, Adres from tblPersoon where BSN = " & lngburgerservicenummer)

if not rst.eof then
   strNaam = rst.fields("Naam")   
   strAdres = rst.fields("Adres")
endif
Er zullen wel tikfouten in staan. Even compileren en aanpassen

HTH:D
 
werk dit ook op een query op deze manier?
 
Geen probleem, je kunt zowel tabellen als queries als bron gebruiken.

Voorbeeldje:
strSQL = "SELECT qWordMerge.* FROM qWordMerge WHERE(CONTACTDATUM =date()-" & iAantalDagen

On Error Resume Next
CurrentDb.QueryDefs.Delete ("qUitleverMerge")
Set temp = CurrentDb.CreateQueryDef("qUitleverMerge", strSQL)
strQuery = "SELECT * FROM qUitleverMerge"

Set rst = New Recordset
DoCmd.Echo False, "Bezig met openen van recordset."
rst.Open strQuery, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rst.MoveFirst

Do While Not rst.EOF
iAantal = iAantal + 1
strVPNaam(iAantal) = rst.Fields("SR_BEDRIJFSNAAM").Value
sBedrijf = UCASE(strVPNaam(iAantal))
strVPNaam(iAantal) = sBedrijf
rst.Fields("SR_BEDRIJFSNAAM").Value = sBedrijf
iSR_ID(iAantal) = rst.Fields("SR_ID").Value
rst.MoveNext
Loop

DoEvents
DoEvents

rst.Close
Set rst = Nothing

Of zoiets...

Michel
 
Private Sub Knop12_Click()
On Error GoTo Err_Knop12_Click

Dim rst As Recordset
Dim dbs As Database

Dim strNaam As String
Dim strAdres As String
Dim strRede As String
Dim lngBurgerServiceNummer As Long
Set dbs = CurrentDb

Set rst = dbs.OpenRecordset("Select Datum, Uren, Rede from rapportsnipperUren where BSN = " & lngBurgerServiceNummer)
If Not rst.EOF Then
strNaam = rst.Fields("Datum")
strAdres = rst.Fields("Uren")
strRede = rst.Fields("Rede")



Dim objMessage, Rcpt

Rcpt = email
Set objMessage = CreateObject("CDO.Message")
objMessage.subject = "Snipper Overzicht"
objMessage.From = """t Brillehuus"" g.gieling@chello.nl"
objMessage.To = Rcpt
objMessage.HTMLBody = [Naam] & " " & [achternaam] & "Datum : " & strNaam & " uren: " & strAdres & " Rede:" & strRede & "<HTML><B><P>Test</P></B></HTML>"

objMessage.Send

End If


Exit_Knop12_Click:
Exit Sub

Err_Knop12_Click:
MsgBox Err.Description
Resume Exit_Knop12_Click

End Sub

zo heb ik nu de code gemaakt, maar nu komt er steeds een fout voor van " Het zijn te weinig parameters, verwachtte aantal is 2"

krijg het er maar niet uit!!!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan