L
Lorne
I have 2 html templates I use for sending mail in outlook. They execute
from macro buttons I added to the menu, and work fine in office 2003. I
just upgraded to office 2007 and the macros not longer work correctly - they
load the text part of stationery and set the sending account but do not
display the page backround image or a jpg embeeded in the page. I get an
error message saying file not found, it must have been moved or deleted but
both jpg's are in the correct folder.
If I open the stationery via the actions menu - send mail using... then both
mail templates appear correctly.
If I open the html file in IE they both display correctly.
The relevant files are all in the folder C:\Program Files\Common
Files\Microsoft Shared\Stationery.
Any idea why the code below is failing?
Code:
***************************
Dim NewMail As Outlook.MailItem
Dim objFS, objStationeryFile
Sub NewLetter2()
Const strStationeryFile = "C:\Program Files\Common Files\Microsoft
Shared\Stationery\Letter2.htm"
Set NewMail = Application.CreateItem(olMailItem)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objStationeryFile = objFS.OpenTextFile(strStationeryFile, 1, False)
NewMail.HTMLBody = objStationeryFile.ReadAll
objStationeryFile.Close
NewMail.Display
End Sub
Sub NewICC()
Const strStationeryFile = "C:\Program Files\Common Files\Microsoft
Shared\Stationery\ICC.htm"
Set NewMail = Application.CreateItem(olMailItem)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objStationeryFile = objFS.OpenTextFile(strStationeryFile, 1, False)
NewMail.HTMLBody = objStationeryFile.ReadAll
objStationeryFile.Close
NewMail.Display
MyStr = Set_Account("ICC", NewMail)
End Sub
Function Set_Account(ByVal AccountName As String, M As Outlook.MailItem) As
String
Dim OLI As Outlook.Inspector
Dim strAccountBtnName As String
Dim intLoc As Integer
Const ID_ACCOUNTS = 31224
Dim CBs As Office.CommandBars
Dim CBP As Office.CommandBarPopup
Dim MC As Office.CommandBarControl
Set OLI = M.GetInspector
If Not OLI Is Nothing Then
Set CBs = OLI.CommandBars
Set CBP = CBs.FindControl(, ID_ACCOUNTS)
If Not CBP Is Nothing Then
For Each MC In CBP.Controls
intLoc = InStr(MC.Caption, " ")
If intLoc > 0 Then
strAccountBtnName = Mid(MC.Caption, intLoc + 1)
Else
strAccountBtnName = MC.Caption
End If
If strAccountBtnName = AccountName Then
MC.Execute
Set_Account = AccountName
GoTo Exit_Function
End If
Next
End If
End If
Set_Account = ""
Exit_Function:
Set MC = Nothing
Set CBP = Nothing
Set CBs = Nothing
Set OLI = Nothing
End Function
from macro buttons I added to the menu, and work fine in office 2003. I
just upgraded to office 2007 and the macros not longer work correctly - they
load the text part of stationery and set the sending account but do not
display the page backround image or a jpg embeeded in the page. I get an
error message saying file not found, it must have been moved or deleted but
both jpg's are in the correct folder.
If I open the stationery via the actions menu - send mail using... then both
mail templates appear correctly.
If I open the html file in IE they both display correctly.
The relevant files are all in the folder C:\Program Files\Common
Files\Microsoft Shared\Stationery.
Any idea why the code below is failing?
Code:
***************************
Dim NewMail As Outlook.MailItem
Dim objFS, objStationeryFile
Sub NewLetter2()
Const strStationeryFile = "C:\Program Files\Common Files\Microsoft
Shared\Stationery\Letter2.htm"
Set NewMail = Application.CreateItem(olMailItem)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objStationeryFile = objFS.OpenTextFile(strStationeryFile, 1, False)
NewMail.HTMLBody = objStationeryFile.ReadAll
objStationeryFile.Close
NewMail.Display
End Sub
Sub NewICC()
Const strStationeryFile = "C:\Program Files\Common Files\Microsoft
Shared\Stationery\ICC.htm"
Set NewMail = Application.CreateItem(olMailItem)
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objStationeryFile = objFS.OpenTextFile(strStationeryFile, 1, False)
NewMail.HTMLBody = objStationeryFile.ReadAll
objStationeryFile.Close
NewMail.Display
MyStr = Set_Account("ICC", NewMail)
End Sub
Function Set_Account(ByVal AccountName As String, M As Outlook.MailItem) As
String
Dim OLI As Outlook.Inspector
Dim strAccountBtnName As String
Dim intLoc As Integer
Const ID_ACCOUNTS = 31224
Dim CBs As Office.CommandBars
Dim CBP As Office.CommandBarPopup
Dim MC As Office.CommandBarControl
Set OLI = M.GetInspector
If Not OLI Is Nothing Then
Set CBs = OLI.CommandBars
Set CBP = CBs.FindControl(, ID_ACCOUNTS)
If Not CBP Is Nothing Then
For Each MC In CBP.Controls
intLoc = InStr(MC.Caption, " ")
If intLoc > 0 Then
strAccountBtnName = Mid(MC.Caption, intLoc + 1)
Else
strAccountBtnName = MC.Caption
End If
If strAccountBtnName = AccountName Then
MC.Execute
Set_Account = AccountName
GoTo Exit_Function
End If
Next
End If
End If
Set_Account = ""
Exit_Function:
Set MC = Nothing
Set CBP = Nothing
Set CBs = Nothing
Set OLI = Nothing
End Function