Excel Macro help with Outlook email

[jcaithness]

Hello all,I am trying to build a macro to send a variable email address depending on what is in the specified field. I need this to work with Outlook as it sends the email from a specified account. I had this working when our site was using groupwise, but I am not sure how to adapt it to work with Outlook in the same way. Option ExplicitPrivate ogwApp As GroupwareTypeLibrary.ApplicationPrivate ogwRootAcct As GroupwareTypeLibrary.account Function Email() 'Macro purpose: To stand as a self contained procedure for creating and 'sending an email to multiple users (if required) 'This code requires: ' -A reference to the Groupware Type Library ' -The following 2 lines declared at the beginning of the MODULE: ' Private ogwApp As GroupwareTypeLibrary.Application ' Private ogwRootAcct As GroupwareTypeLibrary.account ' -The following named ranges on the spreadsheet ' Email_To ' Email_CC 'SECTION 1 'Declare all required variables Const NGW$ = "NGW" Dim ogwNewMessage As GroupwareTypeLibrary.Mail Dim StrLoginName As String, _ StrMailPassword As String, _ StrSubject As String, _ StrBody As String, _ strAttachFullPathName As String, _ sCommandOptions As String, _ cl As Range Dim cell As Range Dim r As Integer 'SECTION 2 'Set all required variables StrLoginName = "sjchshoptech" 'Enter your mailbox ID here StrMailPassword = "sjchshoptech" 'A true password is not required StrSubject = "Status of the PC you requested" StrBody = "Dear " & Cells(ActiveCell.Row, "F").Value & "," & vbCrLf & vbCrLf & _ "The PC you requested, " & Cells(ActiveCell.Row, "C").Value & ", has been completed. Please come to the tech room and pick up " & Cells(ActiveCell.Row, "C").Value & " for deployment. " & vbCrLf & vbCrLf & _ "Sent at " & Format(Now(), "mmm-dd-yyyy hh:mm:ss") 'SECTION 3 'Create the Groupwise object and login in to Groupwise 'Set application object reference if needed If ogwApp Is Nothing Then 'Need to set object reference DoEvents Set ogwApp = CreateObject("NovellGroupWareSession") DoEvents End If If ogwRootAcct Is Nothing Then 'Need to log in 'Login to root account If Len(StrMailPassword) Then 'Password was passed, so use it sCommandOptions = "/pwd=" & StrMailPassword Else 'Password was not passed sCommandOptions = vbNullString End If Set ogwRootAcct = ogwApp.Login(StrLoginName, sCommandOptions, _ , egwPromptIfNeeded) DoEvents End If 'SECTION 4 'Create and Send the Message 'Create new message Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _ ("GW.MESSAGE.MAIL", egwDraft) DoEvents 'Assign "To" recipients ogwNewMessage.Recipients.Add Intersect(ActiveSheet.Range("Email_To"), ActiveCell.EntireRow).Value, NGW, egwTo With ogwNewMessage 'Assign the SUBJECT text If Not StrSubject = "" Then .Subject = StrSubject 'Assign the BODY text If Not StrBody = "" Then .BodyText = StrBody 'Assign Attachment(s) If Not strAttachFullPathName = "" Then .Attachments.Add strAttachFullPathName 'Send the message On Error Resume Next 'Send method may fail if recipients don't resolve .Send DoEvents On Error GoTo 0 End With 'SECTION 5 'Release all variables Set ogwNewMessage = Nothing Set ogwRootAcct = Nothing Set ogwApp = Nothing DoEventsEnd FunctionI am sorry I do not know why it is not showing up right here.

[Kenneth Hobs]

Welcome to the forum! Use Code tags for pasting code. The # icon pastes those tags for you. When you have problems with code paste alignment, try copying to a range and then copy that and then paste between tags.

See these examples. http://www.rondebruin.nl/win/section1.htm

[jcaithness]

Thank you for your reply. I do not see a # and I cannot upload the code as an attachment. I have seen those examples, but I have not been able to get it to work. If you want, I can email you a text file with the code in it.

[Kenneth Hobs]

You must be new to forums in general. You must be using the basic editor. Use the Go Advanced button to get the full editor, or you can use the Full or WYSIWYG editor by clicking Setting hyperlink upper right, General Settings, towards the bottom, choose the editor, and Save Changes.

Or simply type the tags. Replace ()'s with []'s. e.g.
(code)MsgBox "Hi"(/code)

In the Go Advanced editor, the paperclip icon lets you attach files. Obviously, a simple XLSM file is best.

[jcaithness]

Option Explicit
Private ogwApp As GroupwareTypeLibrary.Application
Private ogwRootAcct As GroupwareTypeLibrary.account

Function Email()
'Macro purpose: To stand as a self contained procedure for creating and
'sending an email to multiple users (if required)

'This code requires:
' -A reference to the Groupware Type Library
' -The following 2 lines declared at the beginning of the MODULE:
' Private ogwApp As GroupwareTypeLibrary.Application
' Private ogwRootAcct As GroupwareTypeLibrary.account
' -The following named ranges on the spreadsheet
' Email_To
' Email_CC

'SECTION 1
'Declare all required variables

Const NGW$ = "NGW"
Dim ogwNewMessage As GroupwareTypeLibrary.Mail
Dim StrLoginName As String, _
StrMailPassword As String, _
StrSubject As String, _
StrBody As String, _
strAttachFullPathName As String, _
sCommandOptions As String, _
cl As Range
Dim cell As Range
Dim r As Integer


'SECTION 2
'Set all required variables

StrLoginName = "sjchshoptech" 'Enter your mailbox ID here
StrMailPassword = "sjchshoptech" 'A true password is not required
StrSubject = "Status of the PC you requested"
StrBody = "Dear " & Cells(ActiveCell.Row, "F").Value & "," & vbCrLf & vbCrLf & _
"The PC you requested, " & Cells(ActiveCell.Row, "C").Value & ", has been completed. Please come to the tech room and pick up " & Cells(ActiveCell.Row, "C").Value & " for deployment. " & vbCrLf & vbCrLf & _
"Sent at " & Format(Now(), "mmm-dd-yyyy hh:mm:ss")





'SECTION 3
'Create the Groupwise object and login in to Groupwise

'Set application object reference if needed
If ogwApp Is Nothing Then 'Need to set object reference
DoEvents
Set ogwApp = CreateObject("NovellGroupWareSession")
DoEvents
End If

If ogwRootAcct Is Nothing Then 'Need to log in
'Login to root account
If Len(StrMailPassword) Then 'Password was passed, so use it
sCommandOptions = "/pwd=" & StrMailPassword
Else 'Password was not passed
sCommandOptions = vbNullString
End If

Set ogwRootAcct = ogwApp.Login(StrLoginName, sCommandOptions, _
, egwPromptIfNeeded)
DoEvents

End If

'SECTION 4
'Create and Send the Message
'Create new message
Set ogwNewMessage = ogwRootAcct.WorkFolder.Messages.Add _
("GW.MESSAGE.MAIL", egwDraft)
DoEvents

'Assign "To" recipients
ogwNewMessage.Recipients.Add Intersect(ActiveSheet.Range("Email_To"), ActiveCell.EntireRow).Value, NGW, egwTo

With ogwNewMessage
'Assign the SUBJECT text
If Not StrSubject = "" Then .Subject = StrSubject

'Assign the BODY text
If Not StrBody = "" Then .BodyText = StrBody

'Assign Attachment(s)
If Not strAttachFullPathName = "" Then .Attachments.Add strAttachFullPathName

'Send the message
On Error Resume Next
'Send method may fail if recipients don't resolve
.Send
DoEvents
On Error GoTo 0
End With

'SECTION 5
'Release all variables
Set ogwNewMessage = Nothing
Set ogwRootAcct = Nothing
Set ogwApp = Nothing
DoEvents
End Function

[Kenneth Hobs]

You mean email from someone else's acccount? I don't know about that. If your account, one of Ron's methods will work.

CDO might be a better choice. Ron has an example and here is one at this forum. http://www.vbaexpress.com/forum/showthread.php?t=22439

In any case, here is one of several here at the forum. http://vbaexpress.com/forum/showthread.php?t=21633

[jcaithness]

Essentially my spreadsheet has a column with variable email addresses and when Cell M is equal to "Completed" to send an email to the corresponding email on the same row stating that the computer the person requested is completed. I don't need a mass email sent, just a single one when the situation is correct.

[Kenneth Hobs]

That can easily be done with a Change event.

First, make sure that you can do it. This is much like the link that I posted. This uses late binding so methods and properties of the Outlook object must be known.


Public Sub Test_MailIt()
Range("A1").Value2 = "kenneth.ray.hobson@gmail.com.junk"
MailIt Range("A1").Value2, "Subject Title", "Body string."
End Sub

Private Sub MailIt(eMail As String, sSubject As String, sBody As String)
Dim OLApp As Object
Dim OLNS As Object
Dim oMailItem As Object
Dim oRecipient As Object

Set OLApp = CreateObject("Outlook.Application")
Set OLNS = OLApp.GetNameSpace("MAPI")
OLNS.Logon , , True
Set oMailItem = OLApp.CreateItem(0)
Set oRecipient = oMailItem.Recipients.Add(eMail)
oRecipient.Type = 1
With oMailItem
.Subject = sSubject
.Body = sBody
.Send 'use .Display to test
End With

Set OLApp = Nothing
Set OLNS = Nothing
End Sub

[jcaithness]

Okay, let me see if I understand this. Please correct me if I am wrong.


Public Sub Test_MailIt()
Range("A1").Value2 = "kenneth.ray.hobson@gmail.com.junk"
MailIt Range("A1").Value2, "Subject Title", "Body string."
End Sub


Does this part set the range of column A to the email address? The second part of that sub references to the three variables below? What actually calls this to work on a specific row?

[Kenneth Hobs]

It is just for testing. As I said, setting a change event is easy.

You may want to post a short example workbook as I don't know if the cell in column M is manually entered or set by a formula.

[snb]

or
if the emal address is in column C


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub

If Target.Column & Target.Value = "13Completed" Then ActiveWorkbook.SendMail Target.Offset(, -10).Value, "computer is ready"
End Sub

or


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub

If Target.Column & Target.Value = "13Completed" Then
with CreateObject("Outlook.Application").CreateItem(0)
.to= target.offset(,-10).value
.Subject = "ready"
.Send
End With
end if
End Sub

[jcaithness]

Thank you for the replies, I cannot upload anything for some reason. I do not see a paper clip and nothing happens when I click manage attachments. The setting is set to full WYSIWYG so I uploaded it to google docs. Here is the link to my current spreadsheet. https://docs.google.com/file/d/0B4Kf6CVTg8KwdzJ3bXFXMjAydE0/edit?usp=sharing **EDIT** Hi I was able to get it working the way I wanted it. Thank you everyone.