ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Formatting with Macros (https://www.excelbanter.com/excel-programming/385661-formatting-macros.html)

[email protected]
Formatting with Macros
 
I posted this yesterday, but it looks like I got skipped over.....

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. I was able to italisize it in excel but once the
macro is used the formatting is lost. 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

JLGWhiz
Formatting with Macros
 
It will probably use the default font setting of your Outlook text. Maybe
you can find some help at this site. It also has links to other sites that
offer help.

" wrote:

I posted this yesterday, but it looks like I got skipped over.....

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. I was able to italisize it in excel but once the
macro is used the formatting is lost. 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

[email protected]
Formatting with Macros
 
Thank you! However, it looks like you didn't include a link to a
site....unless you were talking about this site and I misunderstood

Thanks again.

On Mar 20, 10:52 am, JLGWhiz
wrote:
It will probably use the default font setting of yourOutlooktext. Maybe
you can find some help at this site. It also has links to other sites that
offer help.



" wrote:
I posted this yesterday, but it looks like I got skipped over.....

Hello Everyone,

I have the followingmacrothat runs in excel and produces an email
in
outlook2000. 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 thetext. I would like a portion of the body of thetext
to be italicized. I was able to italisize it in excel but once the
macrois used theformattingis lost. The body of thetextis in
column E.

However, when themacroruns and goes intooutlookthe italicize is
gone. Any suggestion on what I should do so that the italicize goes
intooutlook? 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 AsOutlook.Application
Dim olMyEmail AsOutlook.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")

'InitializeOutlook
Set olMyApp = NewOutlook.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\Macroversions\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- Hide quotedtext-

- Show quotedtext-

JLGWhiz
Formatting with Macros
 
Sorry about that, I forgot to paste in the link:

http://www.rondebruin.nl/sendmail.htm

Now you can get there.

" wrote:

Thank you! However, it looks like you didn't include a link to a
site....unless you were talking about this site and I misunderstood

Thanks again.

On Mar 20, 10:52 am, JLGWhiz
wrote:
It will probably use the default font setting of yourOutlooktext. Maybe
you can find some help at this site. It also has links to other sites that
offer help.



" wrote:
I posted this yesterday, but it looks like I got skipped over.....

Hello Everyone,

I have the followingmacrothat runs in excel and produces an email
in
outlook2000. 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 thetext. I would like a portion of the body of thetext
to be italicized. I was able to italisize it in excel but once the
macrois used theformattingis lost. The body of thetextis in
column E.

However, when themacroruns and goes intooutlookthe italicize is
gone. Any suggestion on what I should do so that the italicize goes
intooutlook? 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 AsOutlook.Application
Dim olMyEmail AsOutlook.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")

'InitializeOutlook
Set olMyApp = NewOutlook.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\Macroversions\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- Hide quotedtext-

- Show quotedtext-


All times are GMT +1. The time now is 12:29 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com