Solved: Email through Outlook contacts

[Anomandaris]

Hi guys, I'm posting this again, without the whole code as it made it look complicated...this is the section I need to change to make it email through outlook. The current code was used to send emails from excel via Lotus Notes.






[vba]Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Next line only works with 5.x and above. Replace password with your password
' Session.Initialize ("password")
'Get the sessions username and then calculate the mail file name

UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.sendto = mail2
MailDoc.Subject = " COM trades " & tag1 & Chr(32) & Sheet1.Range("B19")
MailDoc.body = strbody
MailDoc.SaveMessageOnSend = saveit
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.send 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
[/vba]
Looking at the code I'm not sure I need all the stuff dealing with username and passwords do i?

I tried to change it a bit-

[VBA]Dim MailDoc As Object
Dim OLApp as Object
Dim OLContact As Object
Set OLApp = CreateObject("Outlook.Application")
Set EmailItem = OLApp.CreateItem (0)
Set OLContact = OLApp.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
[/VBA]


but as you can see im stuck, please try to help
i'd be very grateful
thanks

[Bob Phillips]

I am not clear on what you are trying to do. In the Lotus version there is a Recipient. How will you identify the recipient in the Outlook version?

[Anomandaris]

Hi xld, thanks for looking at this. I have the full code here, the recipients are listed with the IF Then tag1 statements, depending on the value of tag1 an email is sent out via outlook contact list.
hope this helps








[VBA]

Sub FCMSend()
On Error Resume Next

Dim strbody As String, strsubject As String, first As String, _
second As String, third As String, sendto As String
Dim fourth As String
Dim tag1 As String
Dim intpr As Integer
Dim x As Integer
Dim y As Integer
Dim fifth As String
Dim saveit As String
Dim Recipient As String
Dim tagbody As String
Dim z As Integer
Dim refEnd As Integer
Dim RefST As String
Dim mail2 As String
Dim i As Integer
Dim buysell As String
Dim com As String

com = Sheet1.Range("x19")

intpr = Sheet6.Cells(3, 6).End(xlToRight).Column - 5
refEnd = Sheet1.Cells(18, 7).End(xlDown).row

For x = 8 To 16

If Sheet6.Cells(x, 4) <> 0 Then
tag1 = Sheet6.Cells(x, 4)

For z = 19 To refEnd
If Sheet1.Cells(z, 4) = tag1 Then
RefST = RefST & Sheet1.Cells(z, 7) & Chr(9) & Chr(9) & Sheet1.Cells(z, 5) & Chr(13)
Else
End If

Next


For y = 6 To intpr + 6
If Sheet6.Cells(x, y) <> 0 Then
tagbody = tagbody & Sheet6.Cells(3, y) & Chr(9) & Chr(9) & Sheet6.Cells(x, y) & Chr(10)
Else
End If
Next

second = "Hello" & Chr(13) & Chr(13) & "Confirming the following trades" & Chr(13) & Chr(13)
third = "Qty" & Chr(9) & "Average price" & Chr(9) & Chr(9) & Chr(9) & "Contract" & Chr(13)
fourth = Sheet1.Cells(x - 4, 36) & Chr(9) & Sheet6.Cells(x, 82) & Chr(9) & Chr(9) & Chr(9) & Sheet1.Range("B19") & Chr(9) & Chr(13) & Chr(10) & Chr(13)
fifth = Chr(13) & "Price" & Chr(9) & Chr(9) & "Qty" & Chr(10) & Chr(10)

If fourth = "" Then
fourth = "1" & Chr(9) & Sheet6.Range("g3") & Chr(9) & Chr(9) & Chr(9) & Sheet1.Range("B19") & Chr(9) & Chr(13) & Chr(10) & Chr(13)
Else
fourth = fourth
End If



If Sheet6.Range("f4") = 0 Then
tagbody = Sheet6.Range("g3") & Chr(9) & Chr(9) & Sheet6.Range("g4") & Chr(10)
Else
tagbody = tagbody
End If

strbody = second & third & fourth & "Ref" & Chr(9) & Chr(9) & "Qty" & Chr(13) & RefST & fifth & tagbody

Else
End
End If



If tag1 = "COM" Then
sendto = com
End If
If tag1 = "P" Then
sendto = "P random"
End If
If tag1 = "F" Then
sendto = "F random"
End If
If tag1 = "M" Then
sendto = "M random"
End If
If tag1 = "COW" Then
sendto = "Cow brain"
End If
If tag1 = "PEA" Then
sendto = "Peabrain"
End If
If tag1 = "X" Then
sendto = "X men"
End If
If tag1 = "B" Then
sendto = "barking"
End If
If tag1 = "RR" Then
sendto = "RoR"
End If


For i = 1 To 2
If i = 1 Then
mail2 = sendto
Else
mail2 = Sheet1.Range("Z10")
End If




MsgBox "Sending to " & mail2, vbInformation, "bogus info"
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")
'Next line only works with 5.x and above. Replace password with your password
' Session.Initialize ("password")
'Get the sessions username and then calculate the mail file name

UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
MailDoc.sendto = mail2
MailDoc.Subject = " COM trades " & tag1 & Chr(32) & Sheet1.Range("B19")
MailDoc.body = strbody
MailDoc.SaveMessageOnSend = saveit
'Set up the embedded object and attachment and attach it
'If ATTACHMENT <> "" Then
' Set AttachME = MailDoc.CreateRichTextItem("Attachment")
' Set EmbedObj = AttachME.EmbedObject(1454, "", ATTACHMENT, "Attachment")
' MailDoc.CreateRichTextItem ("Attachment")
' End If
'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
MailDoc.send 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Next
tag1 = ""
tagbody = ""
RefST = ""
tag1 = ""
Next



End Sub

[/VBA]

[Bob Phillips]

Do you want to explain to me in English how tag1 is identified?

[Anomandaris]

Well, I know its a complicated one, some guy wrote this macro for lotus notes and left, it used to work fine with notes but now with outlook it doesnt.

From what I understand tag1 refers to column D in a sheet. In that column if the value in any cell is 'P' then an email is sent out to 'P random' which is the name of a contact list in Outlook, if the cell value in Column D is 'F' then it send email to 'F random' and so on.

What i'm trying to figure out is how to get excel to know that it has to pick emailaddresses from Outlook contact list in the same way that it used to do it for lotusnotes.

I have a feeling i havent explained it well, honestly i dont know how excel identified tag1 even for sending emails thru lotusnotes

[Bob Phillips]

You don't need to pick the names from the contact list, if you have a list called P Random, you can send an email to that list name. Try it and see.

[Anomandaris]

Its not working now, i still have to fix the code, the part where all the mailing stuff is as this mail code is for lotusnotes-

are these Dim's necessary?
[VBA]Dim objFolder As Outlook.MAPIFolder ' Contact folder
Dim objItems As Outlook.Items ' Items of a folder
Dim objContact As Outlook.ContactItem ' Single contact
Dim objMail As Outlook.MailItem ' Single E-Mail
Set objFolder = Outlook.Session.GetDefaultFolder(olFolderContacts)[/VBA]

[Anomandaris]

as you can see im quite confused, these are from outlook-stuff dotcom.

i just know one thing that instead of

Set Session = CreateObject("Notes.NotesSession")

it should be

Set Session = CreateObject("Outlook.Application")

other than that i'm lost

[Bob Phillips]

I still don't get how you get tag1 and I can't test this as I don't have Outlook on this box, but you would use something like

[vba]

Sub Sendmail()
Dim tag1
Dim oOutlook As Object
Dim oMailItem As Object
Dim oRecipient As Object
Dim oNameSpace As Object

'some code to get tag1


Select Case tag1

Case "COM": sendto = com
Case "P": sendto = "P random"
Case "F": sendto = "F random"
Case "M": sendto = "M random"
Case "COW": sendto = "Cow brain"
Case "PEA": sendto = "Peabrain"
Case "X": sendto = "X men"
Case "B": sendto = "barking"
Case "RR": sendto = "RoR"
End Select

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


Set oMailItem = oOutlook.CreateItem(0)
Set oRecipient = oMailItem.Recipients.Add(sendto)
oRecipient.Type = 1 '1 = To, use 2 for cc
'keep repeating these lines with
'your names, adding to the collection.
With oMailItem
.Subject = "The extract has finished."
.Body = "This is an automatic email notification"
' .Attachments.Add ("filename") 'you only need this if
'you are sending attachments?
.Display 'use .Send when all testing done
End With

End Sub
[/vba]

[Anomandaris]

thanks a lot Xld. I'll try it out at work on monday and let you know, i cant try it from home, my outlook doesnt work here.
It looks like it should work though, got my fingers crossed

[Anomandaris]

Hey I tried it, it takes me to Outlook, but is not recognizing the contact list - For eg if we take case 'P' - it displays that it is sending an email to 'P random' , but it isnt recognizing the list of email addresses under 'P random'..........its just treating 'P random' as a word but cant send any email
weird huh

[Anomandaris]

I think the problem may have been on my computer, I've sent in the code to the department and haven't heard back yet, so I'm guessing it works fine. Everything Xld comes up with always works!

So thanks again buddy......we'll call this SOLVED.