jamescol
08-30-2004, 07:33 AM
StaticBob
In response to your PM (original post at http://www.mrexcel.com/board2/viewtopic.php?t=103330)
You should test which Body Format the user has configured. If the format is Plain Text, Rich Text, or Word, then your original .body property will work. If the format is HTML, then you need to wrap your URL in an <A> tag as shown in the sample below.
The <A> tag syntax is:
<A href=myURL>URL Text</A>
Where myURL is the actual HTTP:// link and URL Text is the text you want to display for the link.
Hope this helps!
James
Public Sub sendemail(savepath, docname)
On Error GoTo errorlog
'Declarations
Dim appOutlook As Object
Dim mi As Object
Dim Created As Boolean
Dim safeitem As Object
'Generate mail item
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
myNameSpace.Logon
Set safeitem = CreateObject("Redemption.SafeMailItem") 'Create an instance of Redemption.SafeMailItem
'Set myFolder = myNameSpace.GetDefaultFolder(olFolderOutbox)
Set mi = myOlApp.CreateItem(olMailItem)
safeitem.Item = mi
'mi.Display
If Created Then appOutlook.Quit
'Get the names for document type from given range
Select Case docname
Case "RFI"
Set rng = Worksheets("email").Range("P4:P25")
Case "CVI"
Set rng = Worksheets("email").Range("Q4:Q25")
Case "SI"
Set rng = Worksheets("email").Range("R4:R25")
Case "Call Off"
Set rng = Worksheets("email").Range("S4:S25")
Case "Requisition"
Set rng = Worksheets("email").Range("T4:T25")
Case "Notice"
Set rng = Worksheets("email").Range("U4:U25")
Case Else
MsgBox "No e-mail addresses"
Exit Sub
End Select
'Scan through the range and verify each name
For Each cell In rng.Cells
If cell.Value <> "" Then
Set Rcp = safeitem.Recipients.Add(cell.Value)
'If Not Rcp.Resolve Then
' Rcp.Delete
Else
End If
Next cell
'Get info and send mail
With safeitem.Item
.subject = Worksheets("directory").Range("B3").Value & " - Workbook Notification"
If safeitem.Item.BodyFormat = olFormatHTML Then
safeitem.Item.HTMLBody = "This message has been generated automatically." & vbNewLine & vbNewLine & _
"A new mail has been created in this location. Please click the link to view . . ." & vbNewLine & vbNewLine & _
?<A href=??? & savepath & ???>? & savepath & ?</A>?
Else
safeitem.Item.Body = "This message has been generated automatically." & vbNewLine & vbNewLine & _
"A new " & docname & " has been created in this location. Please click the link to view . . ." & vbNewLine & vbNewLine & _
"<" & savepath & ">"
End If
End With
safeitem.send
Set mi = Nothing
If Created Then appOutlook.Quit
Set appOutlook = Nothing
Exit Sub
In response to your PM (original post at http://www.mrexcel.com/board2/viewtopic.php?t=103330)
You should test which Body Format the user has configured. If the format is Plain Text, Rich Text, or Word, then your original .body property will work. If the format is HTML, then you need to wrap your URL in an <A> tag as shown in the sample below.
The <A> tag syntax is:
<A href=myURL>URL Text</A>
Where myURL is the actual HTTP:// link and URL Text is the text you want to display for the link.
Hope this helps!
James
Public Sub sendemail(savepath, docname)
On Error GoTo errorlog
'Declarations
Dim appOutlook As Object
Dim mi As Object
Dim Created As Boolean
Dim safeitem As Object
'Generate mail item
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
myNameSpace.Logon
Set safeitem = CreateObject("Redemption.SafeMailItem") 'Create an instance of Redemption.SafeMailItem
'Set myFolder = myNameSpace.GetDefaultFolder(olFolderOutbox)
Set mi = myOlApp.CreateItem(olMailItem)
safeitem.Item = mi
'mi.Display
If Created Then appOutlook.Quit
'Get the names for document type from given range
Select Case docname
Case "RFI"
Set rng = Worksheets("email").Range("P4:P25")
Case "CVI"
Set rng = Worksheets("email").Range("Q4:Q25")
Case "SI"
Set rng = Worksheets("email").Range("R4:R25")
Case "Call Off"
Set rng = Worksheets("email").Range("S4:S25")
Case "Requisition"
Set rng = Worksheets("email").Range("T4:T25")
Case "Notice"
Set rng = Worksheets("email").Range("U4:U25")
Case Else
MsgBox "No e-mail addresses"
Exit Sub
End Select
'Scan through the range and verify each name
For Each cell In rng.Cells
If cell.Value <> "" Then
Set Rcp = safeitem.Recipients.Add(cell.Value)
'If Not Rcp.Resolve Then
' Rcp.Delete
Else
End If
Next cell
'Get info and send mail
With safeitem.Item
.subject = Worksheets("directory").Range("B3").Value & " - Workbook Notification"
If safeitem.Item.BodyFormat = olFormatHTML Then
safeitem.Item.HTMLBody = "This message has been generated automatically." & vbNewLine & vbNewLine & _
"A new mail has been created in this location. Please click the link to view . . ." & vbNewLine & vbNewLine & _
?<A href=??? & savepath & ???>? & savepath & ?</A>?
Else
safeitem.Item.Body = "This message has been generated automatically." & vbNewLine & vbNewLine & _
"A new " & docname & " has been created in this location. Please click the link to view . . ." & vbNewLine & vbNewLine & _
"<" & savepath & ">"
End If
End With
safeitem.send
Set mi = Nothing
If Created Then appOutlook.Quit
Set appOutlook = Nothing
Exit Sub