PDA

View Full Version : Solved: Use Command button to e-mail from userform



lhtqasonline
01-15-2009, 03:35 AM
Hi

I wish to use the code that xld posted in a thread called sending email from command button but i have a different need
In my userform i have a textbox called SuppEmail that shows the e-mail address of my supplier from my worksheet
I need the code to take the e-mail address in the textbox and add that as the recipient of the e-mail when i click the button

The code posted by xld was

Dim oOutlook As Object
Dim oMailItem As Object
Dim oRecipient As Object
Dim oNameSpace As Object

Set oOutlook = CreateObject("Outlook.Application", "localhost")
Set oNameSpace = oOutlook.GetNameSpace("MAPI")
oNameSpace.Logon , , True

Set oMailItem = oOutlook.CreateItem(0)
Set oRecipient = _
oMailItem.Recipients.Add("someone@somewhere.com")
oRecipient.Type = 1 '1 = To, use 2 for cc
'keep repeating these lines with
'your names, adding to the collection.
With oMailItem
.Subject = "Subject here"
.body = "body text"
.Attachments.Add ("filename") 'change to your filename
.Display 'use .Send when all testing done
End With

Any ideas

georgiboy
01-15-2009, 03:53 AM
Try this



Dim oOutlook As Object
Dim oMailItem As Object
Dim oRecipient As Object
Dim oNameSpace As Object

Set oOutlook = CreateObject("Outlook.Application")
Set oNameSpace = oOutlook.GetNameSpace("MAPI")
oNameSpace.Logon , , True

Set oMailItem = oOutlook.CreateItem(0)
Set oRecipient = _
oMailItem.Recipients.Add Textbox1.Value
oRecipient.Type = 1 '1 = To, use 2 for cc
'keep repeating these lines with
'your names, adding to the collection.
With oMailItem
.Subject = "The subject matter."
.Body = "The body text"
.Attachments.Add ("filename") 'change to your filename
.Display 'use .Send when all testing done
End With

lhtqasonline
01-15-2009, 04:09 AM
Hi
I substituted the Textbox1 with my name for the text box - SuppEmail
however i get a error message "Compile Error: Expected : End of Statement" :dunno

georgiboy
01-15-2009, 04:23 AM
Private Sub CommandButton1_Click()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim email_ As String
Dim subject_ As String
Dim body_ As String
Dim attach_ As String

Set OutlookApp = CreateObject("Outlook.Application")

email_ = UserForm1.TextBox1.Value
subject_ = "Hello this is the subject"
body_ = "Line 1" & vbNewLine & vbNewLine & "Line 3"

'create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = email_
.Subject = subject_
.Body = body_
'.Attachments.Add "C:\FolderName\Filename.txt"
.Send
End With
End Sub

lhtqasonline
01-15-2009, 04:48 AM
I inserted the code on my project
I checked it using Compile VBAProject with no issues

However when i run my form and click on the command button a window pops up from Microsoft Outlook (2007) stating
A program is trying to send an e-mail message on your behalf.
the it goes on and on and then gives buttons "Allow" "Deny"
If i click Allow it closes the popup but then nothing happens

Any ideas

georgiboy
01-15-2009, 04:50 AM
Have you checked your sent items to see if it sent?

lhtqasonline
01-15-2009, 04:52 AM
Apologies
I just received an reply from my supplier requesting the document i'm referring to in the code
in testing the button it actually sent the e-mail to the supplier
So it seems it works

lhtqasonline
01-15-2009, 04:54 AM
Is there a way to bypass the E-mail popup from Outlook to automatically be allowed?

georgiboy
01-15-2009, 04:59 AM
Try this...

Private Sub CommandButton1_Click()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim email_ As String
Dim subject_ As String
Dim body_ As String
Dim attach_ As String

Set OutlookApp = CreateObject("Outlook.Application")

email_ = UserForm1.TextBox1.Value
subject_ = "Hello this is the subject"
body_ = "Line 1" & vbNewLine & vbNewLine & "Line 3"

'create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)

Application.DisplayAlerts = False
With MItem
.To = email_
.Subject = subject_
.Body = body_
'.Attachments.Add "C:\FolderName\Filename.txt"
.Send
End With
Application.DisplayAlerts = True
End Sub

lhtqasonline
01-15-2009, 06:51 AM
Thank you very much

That worked perfectly

:wavey: