PDA

View Full Version : Appending Outlook Message Subject Line with VBA



OfficeDrone
03-13-2014, 08:51 AM
I've written a short piece of VBA which takes a message and replies to it, adding a 'protective mark' depending on the button selected on a userform. This has been working fine on my 2007 version of Excel and my colleague's 2003 version. Today I tried to install on another coleague's PC (also 2003) and the HTMLBody of the original message is no longer being included in the reply.

VBA Code below. I've emboldened the bit which seems to be the problem. The 'Original' Outlook Mail Item seems to be working as the Subject and Signature are coming through fine. It's just all the text from the original message that's no longer coming through. Any help greatly appreciated.

Private Sub CommandButton1_Click()
UserForm1.Hide
Dim Reply As Outlook.MailItem
Dim Original As Outlook.MailItem
Dim sig As String
sig = ReadSignature("Ben Reply.htm")
Set Original = Application.ActiveExplorer.Selection(1)
Set Reply = Original.Reply
Reply.Subject = Original.Subject & " - UNCLASSIFIED"
Reply.HTMLBody = sig & "<p><BR/><BR/></p>" & Original.HTMLBody
Reply.Display
End Sub

Private Sub CommandButton2_Click()
UserForm1.Hide
Dim Reply As Outlook.MailItem
Dim Original As Outlook.MailItem
Dim sig As String
sig = ReadSignature("Ben Reply.htm")
Set Original = Application.ActiveExplorer.Selection(1)
Set Reply = Original.Reply
Reply.Subject = Original.Subject & " - PROTECT"
Reply.HTMLBody = sig & "<p><BR/><BR/></p>" & Original.HTMLBody
Reply.Display
End Sub

Private Sub CommandButton3_Click()
UserForm1.Hide
Dim Reply As Outlook.MailItem
Dim Original As Outlook.MailItem
Dim sig As String
sig = ReadSignature("Ben Reply.htm")
Set Original = Application.ActiveExplorer.Selection(1)
Set Reply = Original.Reply
Reply.Subject = Original.Subject & " - RESTRICTED"
Reply.HTMLBody = sig & "<p><BR/><BR/></p>" & Original.HTMLBody
Reply.Display
End Sub

Private Function ReadSignature(sigName As String) As String
Dim oFSO, oTextStream, oSig As Object
Dim appDataDir, sig, sigPath, fileName As String
appDataDir = Environ("APPDATA") & "\Microsoft\Signatures"
sigPath = appDataDir & "\" & sigName
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oTextStream = oFSO.OpenTextFile(sigPath)
sig = oTextStream.ReadAll
' fix relative references to images, etc. in sig
' by making them absolute paths, OL will find the image
fileName = Replace(sigName, ".htm", "") & "_files/"
sig = Replace(sig, fileName, appDataDir & "\" & fileName)
ReadSignature = sig
End Function
Private Sub CommandButton4_Click()
UserForm1.Hide
End Sub

Private Sub UserForm_Click()
End Sub

westconn1
03-13-2014, 01:29 PM
i would check if original.htmlbody returns a value, to see if it is that or if it is just not going into the reply for some reason
one way to check
msgbox original.htmlbody