mare
02-02-2012, 05:01 PM
I have this VBA code to export data from excel to outlook email, seems to work ok, but I would like to change the text "Subscription ID#" to bold font.
Any suggestions would greatly be appreciated.
Thanks
Mare
Sub Create_Mail_From_List()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?* (?*@?*.?*)" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Time to Renew"
.body = "Subscription ID# " & Cells(cell.Row, "D").Value & Space(5) & Cells(cell.Row, "E").Value & Space(5) & Cells(cell.Row, "F").Value & vbNewLine & vbNewLine & _
"Dear" & Space(1) & Cells(cell.Row, "A").Value & "," & vbNewLine & vbNewLine & _
"more text"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Any suggestions would greatly be appreciated.
Thanks
Mare
Sub Create_Mail_From_List()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?* (?*@?*.?*)" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Time to Renew"
.body = "Subscription ID# " & Cells(cell.Row, "D").Value & Space(5) & Cells(cell.Row, "E").Value & Space(5) & Cells(cell.Row, "F").Value & vbNewLine & vbNewLine & _
"Dear" & Space(1) & Cells(cell.Row, "A").Value & "," & vbNewLine & vbNewLine & _
"more text"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub