Ok, i have added both the code mentioned on that link
now it looks like below
when i run this code it ask me to select macro "RTFBodyX" when i click then it show me error like "Compile Error: User-defined type not defined" on below lines
Code:
Function fADOGenericRst(ByVal strSource As String, _
Optional cnn As ADODB.Connection, _
Optional pCursorLocation As ADODB.CursorLocationEnum = adUseServer, _
Optional pCursorType As ADODB.CursorTypeEnum = adOpenKeyset, _
Optional pLockType As ADODB.LockTypeEnum = adLockOptimistic, _
Optional pOption As ADODB.ExecuteOptionEnum = -1) As ADODB.Recordset
i think i am making error in names but where don't know
here is the full code in one module
Code:
Function fDAOGenericRst(strSQL As String, _
Optional intType As DAO.RecordsetTypeEnum = dbOpenDynaset, _
Optional intOptions As DAO.RecordsetOptionEnum, _
Optional intLock As DAO.LockTypeEnum, _
Optional pdb As DAO.Database) As DAO.Recordset
Dim db As Database
Dim qdf As QueryDef
Dim rst As DAO.Recordset
Dim prm As DAO.Parameter
If Not pdb Is Nothing Then
Set db = pdb
Else
Set db = CurrentDb
End If
On Error Resume Next
Set qdf = db.QueryDefs(strSQL)
If Err = 3265 Then
Set qdf = db.CreateQueryDef("", strSQL)
End If
On Error GoTo 0
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next
If intOptions = 0 And intLock = 0 Then
Set rst = qdf.fDAOGenericRst(intType)
ElseIf intOptions > 0 And intLock = 0 Then
Set rst = qdf.fDAOGenericRst(intType, intOptions)
ElseIf intOptions = 0 And intLock > 0 Then
Set rst = qdf.fDAOGenericRst(intType, intLock)
ElseIf intOptions > 0 And intLock > 0 Then
Set rst = qdf.fDAOGenericRst(intType, intOptions, intLock)
End If
Set fDAOGenericRst = rst
Set prm = Nothing
Set rst = Nothing
Set qdf = Nothing
Set db = Nothing
End Function
Function fADOGenericRst(ByVal strSource As String, _
Optional cnn As ADODB.Connection, _
Optional pCursorLocation As ADODB.CursorLocationEnum = adUseServer, _
Optional pCursorType As ADODB.CursorTypeEnum = adOpenKeyset, _
Optional pLockType As ADODB.LockTypeEnum = adLockOptimistic, _
Optional pOption As ADODB.ExecuteOptionEnum = -1) As ADODB.Recordset
Dim cmd As New ADODB.Command
Dim prm As ADODB.Parameter
If cnn Is Nothing Then
Set cnn = CurrentProject.Connection
End If
Set cmd.ActiveConnection = cnn
If Left(strSource, 11) <> "PARAMETERS " And Left(strSource, 7) <> "SELECT " Then
strSource = "SELECT * FROM [" & strSource & "]"
End If
cmd.CommandText = strSource
'cmd.Parameters.Refresh 'Is implicit - this is a Jet util so doesn't incur
'overhead penalties
For Each prm In cmd.Parameters
prm.Value = Eval(prm.Name)
Next
Set fADOGenericRst = New ADODB.Recordset
With fADOGenericRst
.CursorLocation = pCursorLocation
.Open cmd, , pCursorType, pLockType, pOption
End With
Set prm = Nothing
Set cmd = Nothing
End Function
Sub RTFBodyX()
'Opens the current access database
Dim db As DAO.Database
Set db = CurrentDb
Dim RS As DAO.Recordset
Dim EmailAdd As String
'Mail Message MM
Dim MM As String
Dim qrySQL As String
Set db = CurrentDb
' Set parameter values.
DoCmd.SetParameter "[Acct_No]", "" & InputBox("Enter Account No:") & ""
'Creates the SQL string - query contains just email addresses
qrySQL = "SELECT * FROM GetData2;"
'creates a recordset (table) based on the sql Statement above
Set RS = fDAOGenericRst(qrySQL, dbOpenDynaset)
Do Until RS.EOF
'creates the email string by reading the email from each record
EmailAdd = EmailAdd & " ; " & RS!Email_Address
'move next record RS!EMAIL
RS.MoveNext
Loop
'creates Email body in HTML Format
MM = "Dear Delegates,"
MM = MM & "Blah blah blah"
'create new email
Set olook = CreateObject("outlook.application")
Set oMail = olook.CreateItem(0)
'Set parameters
With oMail
.To = EmailAdd
.HTMLBody = MM
.Subject = "Our title here"
.CC = "address@address.com"
.Display
End With
End Sub