dimanche 19 avril 2015

VBA Outlook Body Data modification with Default Signature

I am trying to write some code which needs to have specific data while still retaining the Default signature as it is.


For example if i use the function .Body will replace then entire contents of the e-mail with the Body text.



Sub ListView41_DblClick()

Dim strName As String
Dim strEmail As String
Dim strEmail1 As String
Dim OutApp As Object
Dim OutMail As Object
Dim Singlepart As String
Dim SigString As String
Dim Signature As String
Dim strbody As String
Dim SigFilename

strName = ListView41.SelectedItem.Text
strEmail = ListView41.SelectedItem.ListSubItems(1).Text
strEmail1 = ListView41.SelectedItem.ListSubItems(2).Text

check = MsgBox("Send e-mail, To : " & strName & " - " & strEmail & "?" & vbNewLine & _
"CC : " & strEmail1, vbYesNo)

'UserForm1.Show

If check <> vbYes Then Exit Sub

Singlepart = MsgBox("For Single Part or Multiple Parts ? " & vbNewLine & vbNewLine & _
"Single Part = Yes" & vbNewLine & _
"Multiple Parts = No", vbYesNo)

If Singlepart = vbYes Then

' For Single Part Numbers
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"<A HREF=""http://ift.tt/1n4SRuY"">Ron's Excel Page</A>" & _
"<br><br><B>Thank you</B>"

'Signature of User
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Rohith UTAS.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next


Userform1.Show


'With Outlook
With OutMail
.Display
.To = strEmail
.CC = strEmail1
.BCC = ""
.Subject = strName & "_Request for Product Information"
.HTMLBody = strbody & vbNewLine & Signature
.Display 'or .Display if you want the user to view e-mail and send it manually
End With

Else

' For Multiple Part Numbers
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'Signature of User
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Rohith UTAS.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next

'With Outlook
With OutMail
.To = strEmail
.CC = strEmail1
.BCC = ""
.Subject = strName & "_Request for Product Information"
.HTMLBody = "<br>" & _
"Hi," & "<br>" & "<br>" & _
"Can you please provide me the Lifecycle and Years of Availability for the below listed parts?" & "<br />" & "<br />" & _
"The list of parts are : " & "<br />" & "<br />" & "<br />" & "<br />" & "<br />" & "<br />" & Signature
.Display 'or .Display if you want the user to view e-mail and send it manually
End With

End If
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Aucun commentaire:

Enregistrer un commentaire