Email Report (UNDER DEADLINE)

[hootie318]

I have a form with a subform. The form is the date field. The subform are all the stores delivered to on that date. I need to have a command button to open an email with the current date showing and list all the stores with their delivery numbers next to it inside the email.

 

[Brian1960]

Email Report (in body)

Ignore the fact that there is a sub form. It is just data!!!!
Much beter to use a function but here is one way.

Use a cmd button to create the email call it cmdEmail1
EmailAddress is a textfield on the form
strSalesDate is a textfield on the form of date entered

If IsNull(EmailAddress) Or Len(EmailAddress) = 0 Then
    MsgBox "You need an email address!"
    GoTo EndOfSub
Else
    
[INDENT]strTextforLink = "mailto:" & EmailAddress &"?SUBJECT=Sales for "& strSalesDate &"&BODY=Orders for above date" & vbcrlf &""

'create a recodset and build the second half of the body.

Do While not rsList.eof
 'build the body with a dataset
 strSalesInfo = strSalesinfo & rsList.fields("account") &" - "& rsList.fields("InvoiceValue") & vbcrlf
 rsList.movenext
Loop
  'put the two together
  strTextforLink =  strTextforLink & strSalesinfo 
  cmdEmail1.HyperlinkAddress = strTextforlink[/INDENT]


End If

There are better ways of doing this by using a mail server and CDO, but this will point in the right direction.

 

[Ethereal]

Personally i would look into the outlook object and email it that way
----------------------------------------------------------
Private Function GetOutlook() As Boolean
On Error Resume Next

' Assume success
fSuccess = True

Set mOutlookApp = GetObject("", "Outlook.application")

' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
Err.Clear
Set mOutlookApp = CreateObject("Outlook.application")

If Err.Number > 0 Then
MsgBox "Could not create Outlook object", vbCritical
fSuccess = False
Exit Function
End If
End If

' If we've made it this far, we have an Outlook App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")

If Err.Number > 0 Then
MsgBox "Could not create NameSpace object", vbCritical
fSuccess = False
Exit Function
End If

' Return the Success Flag as the value of GetOutlook()
GetOutlook = fSuccess

End Function


Public Function SendMessage() As Boolean
' The SendMessage() function reads user entered values and
' actually sends the message.

On Error Resume Next

Dim strSubject As String
Dim strMsg As String
Dim strAttachment As String

strSubject = "Electronic Sample No. " & Forms!fSampleView!SamID & " from Barber Glass"
strAttachment = Forms!fSampleView![SamPhoto]
' Assume success
fSuccess = True

' Here's where the real Outlook Automation takes place
If GetOutlook = True Then
Set mItem = mOutlookApp.CreateItem(olMailItem)
'mItem.Recipients.Add strRecip
mItem.Subject = strSubject

' This code allows for 1 attachment, but with slight
' modification, you could provide for multiple files.
If Len(strAttachment) > 0 Then
mItem.Attachments.Add strAttachment
End If
Dim strHTML As String
strHTML = "Hello,<br>" & _
"Thank you for your interest in Barber Glass. We would be more than happy to answer " & _
"any questions you may have regarding this sample or any other products we offer. To help " & _
"us service you better please reference the Sample Number (No. " & Forms!fSampleView!SamID & _
") when speaking with any of our representatives.<br>" & _
"<br>" & _
"<b>Technical information pertaining to this product:</b><br><br>"
If MaxDim And MinDim Then
strHTML = strHTML & " Length Min " & Forms!fSampleView.txtSamMinHeight & _
" Max " & Forms!fSampleView.txtSamMaxHeight & " Width Min " & _
Forms!fSampleView.txtSamMinWidth & " Max " & _
Forms!fSampleView.txtSamMaxWidth
ElseIf MaxDim Then
strHTML = strHTML & "Maximum Dimensions of this Product are " & Forms!fSampleView.txtSamMaxWidth & _
" x " & Forms!fSampleView.txtSamMaxHeight
ElseIf MinDim Then
strHTML = strHTML & "Minumum Dimensions of this Product are " & Forms!fSampleView.txtSamMinWidth & _
" x " & Forms!fSampleView.txtSamMinHeight
End If

If Thickness Then
strHTML = strHTML & "<br>Nominal Thickness: " & Forms!fSampleView.txtSamThickness & " mm"
End If
If LightTrans Then
strHTML = strHTML & "<br>Light Trans: " & Forms!fSampleView.txtSamLight & "%"
End If
strHTML = strHTML & "<br>Manufacturing Tolerance: " & Forms!fSampleView!SpecDesc
If IsNull(Forms!fSampleView!SamPhoto) = False Then
strHTML = strHTML & "<br><br><img src = " & strAttachment & _
"><br>"
End If
strHTML = strHTML & "<br><br><b><u>Glass Thickness Tolerance</u></b><br><br>Our standard tolerances for " & _
"length and width are as follows:<br>3 to 8 mm +/- 1/16" & Chr$(34) & " (1.5 mm)<br>10 to 19 mm +/- 1/8" & Chr$(34) & " (4mm)<br>" & _
"<b><font size =-1><br>The resolution of the image that you see on your screen will vary depending on your " & _
"computer hardware, therefore this image is intended to be used as a concept sample only. To obtain a " & _
"physical sample please contact us at (519) 824-2399. We are always happy to help with all your " & _
"glass needs. Barber Glass, your glass experts!</font></b>"



mItem.HTMLBody = strHTML
mItem.Display



End If

' Release resources
Set mOutlookApp = Nothing
Set mNameSpace = Nothing

If Err.Number > 0 Then fSuccess = False
SendMessage = fSuccess

End Function
----------------------------------------------
That's a sample from one of my applications -- Make sure the outlook object is checked off under the referances menu!