rplx10
01-13-2013, 10:14 AM
Hi All,
I'm new to the site and to VBA. I was wondering if anyone could assist with a macro merge. I have two working macros (one I would like to tweak) but I am unable to make them work together.
I would appreciate any assistance that you can provide.
Thank you.
1st Macro used to generate multiple emails and populate fields and place attachments in email.
Sub SendingSheet()
Dim oMSOutlook As Object
Dim oEmail As Object
Dim x As Integer
x = 2
Do While IsEmpty(ActiveSheet.Cells(x, 1)) = False
Set oMSOutlook = CreateObject("Outlook.Application")
Set oEmail = oMSOutlook.CreateItem(olMailItem)
With oEmail
.To = ActiveSheet.Cells(x, 1)
.CC = ActiveSheet.Cells(x, 2)
.BCC = ActiveSheet.Cells(x, 3)
.Subject = ActiveSheet.Cells(x, 4)
'.Body = ActiveSheet.Cells(x, 5)
.Attachments.Add ActiveSheet.Cells(x, 6).Value
x = x + 1
.Display
End With
Loop
Set oMSOutlook = Nothing
Set oEmail = Nothing
End Sub
2nd Macro used to Insert Body into email using .doc file.
I would like to tweak this one...so that formatting is retained when being brought over to Outlook (spacing, hyperlinks, etc.) and providing a source path within the excel sheet (ex. Field 2,5) that contains path info for the .doc file containing the body to be used per outgoing email.
Sub SendOutlookMessages()
Dim OL As Object, MailSendItem As Object
Dim W As Object
Dim MsgTxt As String, SendFile As String
Dim ToRangeCounter As Variant
SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
"file to mail, then click 'Open'", buttontext:="Send", _
MultiSelect:=False)
Set W = GetObject(SendFile)
MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
End:=W.Paragraphs(W.Paragraphs.Count).Range.End)
Set W = Nothing
Set OL = CreateObject("Outlook.Application")
Set MailSendItem = OL.CreateItem(olMailItem)
ToRangeCounter = 0
With MailSendItem
.Body = MsgTxt
.Display
End With
Set OL = Nothing
End Sub
My Purpose is to create multiple emails that are to be either displayed or placed directly within Draft box (.Save) to be checked out for mistakes before leaving to desired recipients.
I'm new to the site and to VBA. I was wondering if anyone could assist with a macro merge. I have two working macros (one I would like to tweak) but I am unable to make them work together.
I would appreciate any assistance that you can provide.
Thank you.
1st Macro used to generate multiple emails and populate fields and place attachments in email.
Sub SendingSheet()
Dim oMSOutlook As Object
Dim oEmail As Object
Dim x As Integer
x = 2
Do While IsEmpty(ActiveSheet.Cells(x, 1)) = False
Set oMSOutlook = CreateObject("Outlook.Application")
Set oEmail = oMSOutlook.CreateItem(olMailItem)
With oEmail
.To = ActiveSheet.Cells(x, 1)
.CC = ActiveSheet.Cells(x, 2)
.BCC = ActiveSheet.Cells(x, 3)
.Subject = ActiveSheet.Cells(x, 4)
'.Body = ActiveSheet.Cells(x, 5)
.Attachments.Add ActiveSheet.Cells(x, 6).Value
x = x + 1
.Display
End With
Loop
Set oMSOutlook = Nothing
Set oEmail = Nothing
End Sub
2nd Macro used to Insert Body into email using .doc file.
I would like to tweak this one...so that formatting is retained when being brought over to Outlook (spacing, hyperlinks, etc.) and providing a source path within the excel sheet (ex. Field 2,5) that contains path info for the .doc file containing the body to be used per outgoing email.
Sub SendOutlookMessages()
Dim OL As Object, MailSendItem As Object
Dim W As Object
Dim MsgTxt As String, SendFile As String
Dim ToRangeCounter As Variant
SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
"file to mail, then click 'Open'", buttontext:="Send", _
MultiSelect:=False)
Set W = GetObject(SendFile)
MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
End:=W.Paragraphs(W.Paragraphs.Count).Range.End)
Set W = Nothing
Set OL = CreateObject("Outlook.Application")
Set MailSendItem = OL.CreateItem(olMailItem)
ToRangeCounter = 0
With MailSendItem
.Body = MsgTxt
.Display
End With
Set OL = Nothing
End Sub
My Purpose is to create multiple emails that are to be either displayed or placed directly within Draft box (.Save) to be checked out for mistakes before leaving to desired recipients.