Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro that loses formatting
Hello Everyone,
I have the following macro that runs in excel and produces an email in outlook 2000. Generally the way it works is that it fills out the to, cc and subject fields, attaches 1 or 2 documents and then also creates the body of the text. I would like a portion of the body of the text to be italicized. The body of the text is in column E. However, when the macro runs and goes into outlook the italicize is gone. Any suggestion on what I should do so that the italicize goes into outlook? I'm assuming the problem is in this : doc.MailEnvelope.Introduction = ActiveCell.Offset(0, 4).Text Thank you in advance!!!!! Sub JY_Marco() Dim wkb As Workbook Dim wks As Worksheet Dim rng As Range Dim rng2 As Range Dim olMyApp As Outlook.Application Dim olMyEmail As Outlook.mailItem Dim wd As Word.Application Dim doc As Word.Document Dim itm As Object Dim ID As String Dim body As String Dim blnWeOpenedWord As Boolean 'On Error Resume Next 'Initialize Word Set wd = GetObject(, "Word.Application") If wd Is Nothing Then Set wd = CreateObject("Word.Application") blnWeOpenedWord = True End If 'Initialize Workbook Set wkb = ThisWorkbook Set wks = wkb.Worksheets("Sheet1") Set rng = wks.Range("A2") 'Initialize Outlook Set olMyApp = New Outlook.Application Set olMyEmail = olMyApp.CreateItem(olMailItem) 'Start Range at Cell A2 Range("A2").Select 'Loop through all rows in spreadsheet Do Until IsEmpty(ActiveCell) Set doc = wd.Documents.Open _ (Filename:="\\ntdisk01\dcm\Staff\Mar-Star\Macro versions\NY\JY \WEEKLY MARKET UPDATE SUMMARY.doc ", ReadOnly:=True) 'Set doc = wd.Documents.Open(CStr(ActiveCell.Offset(0, 2).Hyperlinks.Item(1).Address)) Set itm = doc.MailEnvelope.Item doc.MailEnvelope.Introduction = ActiveCell.Offset(0, 4).Text With itm .To = ActiveCell.Text .CC = ActiveCell.Offset(0, 5).Text .Subject = ActiveCell.Offset(0, 1).Text .Attachments.Add (CStr(ActiveCell.Offset(0, 3).Value)) If Len(Trim(ActiveCell.Offset(0, 6).Value)) 0 Then .Attachments.Add CStr(ActiveCell.Offset(0, 6).Value) End If If Len(Trim(ActiveCell.Offset(0, 7).Value)) 0 Then .Attachments.Add CStr(ActiveCell.Offset(0, 7).Value) End If .Save End With Set itm = Nothing doc.Close wdDoNotSaveChanges If blnWeOpenedWord Then wd.Quit End If ActiveCell.Offset(1, 0).Select Loop MsgBox "You successfully sent the email & attachment to your drafts folder." Set olMyApp = Nothing Set olMyEmail = Nothing Set doc = Nothing Set itm = Nothing Set wd = Nothing End Sub THANKS AGAIN! |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copying tab loses formatting | Excel Worksheet Functions | |||
copy/paste loses formatting | Excel Discussion (Misc queries) | |||
Excel 2007 Loses Formatting | Excel Discussion (Misc queries) | |||
Protecting Cell loses formatting | Excel Discussion (Misc queries) | |||
Excel workspace loses formatting | Excel Discussion (Misc queries) |