E-mail template editing via Excel spreadsheet

  • Thread starter Thread starter G-2008
  • Start date Start date
G

G-2008

Hi

Didn't know for sure if this question would be best posted in this forum or
an Excel forum, but not able to find it currently in either place. I have a
spreadsheet that accesses email templates (.msg) stored outside Outlook on
the local hard drive. It allows me to edit multiple templates at once
instead of having to edit each one individually. For example, if a manager
is replaced I can pull every template into the spreadsheet, find/replace the
old manager with the new, and save the templates back again.

Everything works perfectly unless there is an ambiguous email address. In
this case the template is simply saved as-is and each time the template is
used it requires me to resolve the ambiguity. I need to be able to invoke
the 'Check Names' dialog if an ambiguity is detected prior to saving changes
to a template, but can't figure out how to do that. Here is my latest
attempt:

Dim oAPP As Outlook.Application
Dim oMENU As Object
Dim oCMD As Object
Dim oMSG As MailItem

Set oMSG = Outlook.CreateItemFromTemplate(strFILE)

<edit recipients>

If Not oMSG.ResolveAll Then
Set oMENU = oAPP.ActiveInspector.CommandBars("Tools")
Set oCMD = oMENU.Controls("Check Names")
oCMD.Execute
End If

<save template>


I am using Office 2003 SP3 and just want the Check Names dialog box to open
so I can resolve Recipients prior to saving the template so I don't get
prompted every time I use the template. Can anyone help me out?

Thanks in advance.
 
Sorry, that last block of code should be:

If Not oMSG.Recipients.ResolveAll Then
^^^
Set oMENU = oAPP.ActiveInspector.CommandBars("Tools")
Set oCMD = oMENU.Controls("Check Names")
oCMD.Execute
End If

Also, don't know what I was thinking, the error I'm getting is on 'Set oMENU:

Run-time error '91': Object variable or With block variable not set
 
You don't appear to be instantiating the Outlook application anywhere.
You have to set an object reference to the Outlook Application object.
Try adding this at the top of your code:

Set oAPP = New Outlook.Application

Your code is reinforcing this behavior because you aren't consistently
referring to the same objects. For example:

Set oMSG = Outlook.CreateItemFromTemplate(strFILE)

In this line of code you avoid the above problem because you reference
the Application object directly, yet further down in the code you try
to use the object reference to refer to the same object. Use "oAPP"
consistently to set a reference to the Application object. Does that
make sense?

Also you might want to use the FindControl ID to refer to the "Check
Names" option, in case someone changes the name of the menu item (or
uses it in a non-English version of Excel). The FindControl ID for
that is 361, so to execute that command try this code:

Application.CommandBars.FindControl(ID:=361).Execute


HTH,
JP
 
Thanks for responding. I know the code is kind of messy right now, thanks
for pointing out the inconsistency in the Application object. I had
instantiated the object but omitted it from my code earlier. Here is the
entire block:

Public Sub SaveFiles()
Dim strDEST As String
Dim intFILEROW As Integer
Dim strFILE As String
Dim oFS As New FileSystemObject
Dim oMAILITEM As MailItem
Dim oRECIPIENTS As Recipients
Dim oRECIPIENT As Recipient
Dim oMENU As Object
Dim oCMD As Object
Dim vARRAY As Variant
Dim strTO As String
Dim strCC As String
Dim x As Integer
Dim oAPP As Outlook.Application

Set oAPP = New Outlook.Application

strDEST = Sheet1.Cells(3, 2).Value
If strDEST = "" Then
MsgBox "You must first select a destination Folder.", vbOKOnly,
"ERROR"
Exit Sub
End If
intFILEROW = 6
strFILE = Sheet1.Cells(intFILEROW, 1).Value

While strFILE <> ""
On Error GoTo errHandle

'Set initial values
strTO = ""
strCC = ""
Set oMAILITEM = oAPP.CreateItem(olMailItem)
Set oRECIPIENTS = oMAILITEM.Recipients
Sheet1.Range("A" & intFILEROW, "D" & intFILEROW).Select

'Set Subject
oMAILITEM.Subject = Sheet1.Cells(intFILEROW, 2).Value

'Set TO Recipients
vARRAY = Split(Sheet1.Cells(intFILEROW, 3).Value, ";", ,
vbTextCompare)
For x = 0 To UBound(vARRAY)
strTO = strTO & Trim(vARRAY(x)) & "; "
Next x
oMAILITEM.To = strTO

'Set CC Recipients
vARRAY = Split(Sheet1.Cells(intFILEROW, 4).Value, ";", ,
vbTextCompare)
For x = 0 To UBound(vARRAY)
strCC = strCC & Trim(vARRAY(x)) & "; "
Next x
oMAILITEM.CC = strCC

'Resolve Recipients
oRECIPIENTS.ResolveAll

'Prompt for still unresolved Recipients
If Not oRECIPIENTS.ResolveAll Then
Set oMENU = oAPP.ActiveInspector.CommandBars.FindControl(ID:=361)
Set oCMD = oMENU.Controls("Check Names")
oCMD.Execute
End If

'Save
oMAILITEM.SaveAs strDEST & "\" & strFILE

errHandle:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf &
vbCrLf & _
"File will be skipped.", vbOKOnly, "ERROR"
Err.Clear
End If

'Move to next MailItem
intFILEROW = intFILEROW + 1
strFILE = Sheet1.Cells(intFILEROW, 1).Value
Set oMAILITEM = Nothing
Wend

'Release memory and exit
Set oRECIPIENTS = Nothing
Set oMAILITEM = Nothing
Set oRECIPIENTS = oMAILITEM.Recipients
End Sub


Still getting the "Run-time error '91': Object variable or With block
variable not set" error on the "Set oMENU =
oAPP.ActiveInspector.CommandBars.FindControl(ID:=361)" line. Any other ideas?
 
I have devised a workaround that prompts to open the mailitem and edit
manually if recipients don't all resolve. Working to add option to resolve
same string to same recipient for the rest of the messages in that folder and
that should accomplish what I need. It would still be cleaner to use just
the Check Names dialog to resolve the single recipient that doesn't resolve -
anyone got any ideas why the code I'm using doesn't work? (code in previous
post)
 
FindControl is a Method, not an Object, but oMENU is declared as
Object, so you will get the error. You should use something like

If Not oRECIPIENTS.ResolveAll Then

oAPP.ActiveInspector.CommandBars.FindControl(ID:=361).Execute
End If

See if that fixes it. Also if I can give you some constructive
criticism, you should never use the New keyword in a declaration:

Dim oFS As New FileSystemObject

This instantiates the object at the beginning of the sub, which is
never what you want. Instead you should use

Dim oFS As Scripting.FileSystemObject
Set oFS = New Scripting.FileSystemObject
(assuming early binding)

HTH,
JP
 
OK - figured it out. I had the hierarchy wrong. ActiveInspector, at least
the way I'm needing to use it, is associated with the MailItem and I had been
associating it with Outlook.Application. Also, I had not been specifying
which CommandBar in the CommandBars collection. Here is the code that works
(I just wrote it in a click event for development but will be rewriting it as
a standalone Sub). Hope there are others out there who can get some use out
of this:

Private Sub CommandButton1_Click()
Dim oOL As Outlook.Application
Dim oINSP As Inspector
Dim oCBs As CommandBars
Dim oCB As CommandBar
Dim oCMD As CommandBarControl
Dim oMAIL As MailItem
Dim oRECIPS As Recipients
Dim iTOP As Integer
Dim iRESP As Integer

Set oOL = New Outlook.Application
Set oMAIL = oOL.CreateItemFromTemplate(Sheet1.Cells(3,1).Value)
Set oRECIPIENTS = oMAIL.Recipients

If Not oRECIPIENTS.ResolveAll Then
Set oINSP = oMAIL.GetInspector
'These are separated into different objects to demonstrate the object
hierarchy
'In production there would likely be no object variables created and
'the Execute statement would be written as:
' oINSP.CommandBars("Standard").Controls("Check Names").Execute
Set oCB = oINSP.CommandBars("Standard")
Set oCMD = oCB.Controls("Check Names")

iTOP = oINSP.Top 'Get initial value of MailItem Form position
oINSP.Top = 2000 'Position Form out of viewing area
oINSP.Display 'Check Names dialog will only be visible if Form
is visible

iRESP = vbYes
While iRESP = vbYes
oCMD.Execute 'Code stops until processing of this line
completes,
'meaning Check Names dialog was closed
If Not oRECIPIENTS.ResolveAll Then 'If there are still unresolved
Recipients
iRESP = MsgBox ("There are still unresolved recipients, " & _
"are you sure you don't want to resolve
them?", _
vbYesNo, "Are you sure?")
If iRESP = vbNo Then 'If user wants to continue resolving Recipients
oCMD.Execute 'redisplay dialog
End If
End If
Wend

oINSP.Close olDiscard 'Closing Check Names dialog does not close Form
oINSP.Top = iTOP 'Restore Form position to previous value

Set oCMD = Nothing
Set oCB = Nothing
Set oINSP = Nothing
End If

Set oRECIPIENTS = Nothing
Set oMAIL = Nothing
Set oOL = Nothing
End Sub
 
Back
Top