Creating a function to send an email

[Sangmond]

I was wondering if someone could give me help in setting up a function that will allow me to send an email to someone when I press the "SEND EMAIL" button. The person recieving the email will always be the same. Also I want to send the value of a textbox in the email.

I have been puzzling over how to do this for a week now and I have no idea even how to begin. So any help will be great.

Thanks

 

[SpankYou]

Hey,

Below is a slightly more advanced email code than you want but you should be able to figure out the necessary bits, If you need any more help just let me know...


Dim RespEmail As String

'Connect to Contact Table

Dim CnnDB As ADODB.Connection
Dim RstContact As ADODB.Recordset
Set CnnDB = Application.CurrentProject.Connection
Set RstContact = New ADODB.Recordset


'Open Recordset
RstContact.Open Source:="Contact", ActiveConnection:=CnnDB, CursorType:=adOpenForwardOnly, LockType:=adLockPessimistic

'Load Email Addresses
Dim StrEmailAddressSend As String
Dim strEmailAddress As String
Dim ErrResponse As String
Dim olMailItem

'Store HyperLink
Dim HypLink As String
HypLink = "file:///" & "C:\WINDOWS\Desktop\Budget%20Sales%20Vs%20Actual%20Sales" & "%20-%20" & strDate & ".doc"


On Error GoTo ErrHandler:




'Would user like to email contacts to confirm forecast completion
RespEmail = MsgBox("Would You Like To Inform Your Contacts That The Report Is Complete?", vbYesNo, "Email Request&quot

'If user says yes to email...
If RespEmail = vbYes Then

'Email all contacts neccesary
Dim myOlApp, myItem, myAttachments
Dim fs As Object

'While Not End Of File (sends to all contacts)
Do Until RstContact.EOF = True
'The variable links to relevant Field
strEmailAddress = strEmailAddress & RstContact.Fields("EmailAddress&quot & "; "
'move record to next pointer
RstContact.MoveNext
Loop

StrEmailAddressSend = Left$(strEmailAddress, Len(strEmailAddress) - 2)

'creates instance of outlook
Set myOlApp = CreateObject("Outlook.Application&quot
'Creates new email
Set myItem = myOlApp.CreateItem(olMailItem)
'Declares possible attachment transfer
Set myAttachments = myItem.Attachments
'Body text
myItem.Body = vbCrLf & "The New Budget Sales Vs Actual Sales Report Is Complete - " & vbCrLf & vbCrLf & HypLink & vbCrLf & vbCrLf & vbCrLf & "Thanks"
'Subject text
myItem.Subject = "Budget Sales Vs Actual Sales Report Complete"
'Declare email Address
myItem.To = StrEmailAddressSend
'Below line could send document with email If required.
'myAttachments.Add "C:\WINDOWS\Desktop\Document.Doc", olByValue, 200, "Give It a Heading"
myItem.Display

End If


Exit Sub

ErrHandler:
MsgBox Err.Number & " : " & Err.Description
'DoCmd.Close
Exit Sub

ErrExit:
DoCmd.Close

hope this helps


Sam

"You couldn't fool your mother on the foolingest day of your life if you had an electrified fooling machine." - Homer

 

[SpankYou]

This should do exactly what you want...


'Load Email Addresses
Dim StrEmailAddressSend As String


Dim olMailItem

'Store textBox Value
Dim TextValue As String
TextValue = text1.text

'Store EmailAddress
StrEmailAddressSend = "Me@Hotmail.com"

On Error GoTo ErrHandler:




'Would user like to email contacts to confirm forecast completion
RespEmail = MsgBox("Would You Like To Inform Your Contacts That The Report Is Complete?", vbYesNo, "Email Request&quot

'If user says yes to email...
If RespEmail = vbYes Then

'creates instance of outlook
Set myOlApp = CreateObject("Outlook.Application&quot
'Creates new email
Set myItem = myOlApp.CreateItem(olMailItem)
'Declares possible attachment transfer
Set myAttachments = myItem.Attachments
'Body text
myItem.Body = TextValue
'Subject text
myItem.Subject = "your Subject Here"
'Declare email Address
myItem.To = StrEmailAddressSend
'Below line could send document with email If required.
'myAttachments.Add "C:\WINDOWS\Desktop\Document.Doc", olByValue, 200, "Give It a Heading"
myItem.Display

End If


Exit Sub

ErrHandler:
MsgBox Err.Number & " : " & Err.Description
'DoCmd.Close
Exit Sub

ErrExit:

Exit Sub


Hope This Helps



Sam

"You couldn't fool your mother on the foolingest day of your life if you had an electrified fooling machine." - Homer

 

[Sangmond]

Thanks for the help, I was wondering if this works with Outlook Express because I get 429 active X error

 

[VBAjedi]

Sangmond,

What application are you working with (i.e. where do you want your button) - Outlook, Excel, Word, a standalone VB app, or???



VBAjedi

 

[Sangmond]

The button is in VBA using excel
And I want to send an email through outlook express (Outlook is not installed on the machine)
The code above works but I still get the active x error

Thanks
Sangmond

 

[mrmovie]

you might want to try CDONTS, do a key word search for it here or in vbscript forum or perhaps vb proper

 

[mrmovie]

Set Message = CreateObject("CDONTS.NewMail&quot


Message.From = "someone@localhost"
Message.To = "someoneelse@localhost"
Message.Cc = ""
Message.Subject = "This is the subject"
Message.Body = "This is the body"

Message.Send

Set Message = Nothing

does that do anything?