PDA

View Full Version : Expert Needed Macro Assist



rplx10
01-23-2013, 09:05 AM
HI All,

I have a Macro that is being used to generate mass outgoing email via MS Outlook. The macro is compiling info from excel and populating all allocated fields within Outlook and placing items within the Draft Box for Quality Assurance review before being sent out to Clients.


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)
'This works but not for paragraphs with formatting, hyperlinks, spacing, etc.
.Body = ActiveSheet.Cells(x, 5)
.Attachments.Add ActiveSheet.Cells(x, 6).Value
x = x + 1

'.Send
'.Display
.Save

End With
Loop

Set oMSOutlook = Nothing
Set oEmail = Nothing
End Sub


The issue at hand is that I am unable to Populate the "BODY" field from a Word Document. Idealy I would like to have a field in my Excel Sheet that has the pathing info of the Word files I would like associated with whatever emails I am generating.

I have attached a sample spreadsheet for trial and error purposes. Anyone that can assist your help and your time is much appreciated.

Muthukumar
01-29-2013, 09:09 PM
I got something related while surfing.. Hope this helps for you..

Sub SendDocAsMsg()
Dim wd As Word.Application
Dim doc As Word.Document
Dim itm As Object
Dim ID As String
Dim blnWeOpenedWord As Boolean
On Error Resume Next

Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
blnWeOpenedWord = True
End If
Set doc = wd.Documents.Open _
(FileName:="C:\Current.doc", ReadOnly:=True)
Set itm = doc.MailEnvelope.Item
With itm
.To = "Address"
.Subject = "Subject"
.Save
ID = .EntryID
End With
Set itm = Nothing

Set itm = Application.Session.GetItemFromID(ID)
itm.Send
doc.Close wdDoNotSaveChanges
If blnWeOpenedWord Then
wd.Quit
End If

Set doc = Nothing
Set itm = Nothing
Set wd = Nothing
End Sub