bjsusol
07-17-2008, 12:05 PM
Good Afternoon!
I have what I hope is a fairly simple question. I have a template from Office 2003 that I need to convert to 2007. The purpose of the template is to allow a user to open it, fill it out, and then open an email (that they will click to send) that contains the contents of the workbook (in HTML) as well as an attachment of the file.
In 2003, it works perfectly.
In 2007, I have "issues"
When using excel 2007 to work with the template, any time I click one of the buttons (urgent, confidential,normal - all this really does is change the subject and priority when creating the email) I get an error "Application Defined or Object-Defined error" in the SendMail() function
I have enabled all macros in the trust center for outlook and excel. It has not seemed to make a difference. This makes me think something changed in the VBA.
Its not a really long piece of code, but its long enough. If anyone would be willing to take a look, I would greatly appreciate it. (I also posted this on the msdn board)
If anyone is willing, I could provide the template itself to take a look at.
'*** Declare module level variables
Option Explicit
'Dim mOutlookApp As Outlook.Application
'Dim mNameSpace As Outlook.NameSpace
'Dim mItem As Outlook.MailItem
Dim mOutlookApp As Object
Dim mNameSpace As Object
Dim mItem As Object
Dim fSuccess As Boolean
Const TMP_FILE As String = "C:\Conflict01.xlsx" '*** used by SendMessage()
'***--------------------------------------------------------------------------
'*** Called by buttons on the conflict sheet
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Sub EmailConflictConfidential()
'*** Extremely Confidential
Dim i As Integer
Dim sClientCell As String
Dim sAddStr As String
On Error Resume Next
sAddStr = TMP_FILE
Kill sAddStr
i = GetOutlook()
'smwm - takes care of the client name and importance label
SetClientCell (1)
i = SendMessage(1)
End Sub
Sub SetClientCell(intClientType As Integer)
'Takes care of the client name and importance label
'1 = Extremely Confidential
'2 = Extremely Urgent and Confidential
'3 = Normal
Dim strConfidential As String
Dim strUrgentConfidential As String
Dim strClient As String
Dim intLengthConfidential As Integer
Dim intLengthUrgentConfidential As Integer
strConfidential = "EXTREMELY CONFIDENTIAL - "
strUrgentConfidential = "EXTREMELY URGENT AND CONFIDENTIAL - "
intLengthConfidential = Len(strConfidential)
intLengthUrgentConfidential = Len(strUrgentConfidential)
strClient = ActiveSheet.Range("B13").Value
If InStr(strClient, strConfidential) <> 0 Then
strClient = Mid(strClient, intLengthConfidential, Len(strClient))
ElseIf InStr(strClient, strUrgentConfidential) <> 0 Then
strClient = Mid(strClient, intLengthUrgentConfidential, Len(strClient))
End If
If intClientType = 1 Then
strClient = strConfidential & strClient
ElseIf intClientType = 2 Then
strClient = strUrgentConfidential & strClient
End If
ActiveSheet.Range("B13").Value = strClient
End Sub
'*** Called by buttons on the conflict sheet
'*** 2/9/06 Sarah Maston
'***----------------------------------------
Sub EmailConflictUrgentConfidential()
'*** Emergency Conflict
Dim i As Integer
Dim sClientCell As String
Dim sAddStr As String
On Error Resume Next
sAddStr = TMP_FILE
Kill sAddStr
'smwm - takes care of the client name and importance label
SetClientCell (2)
i = GetOutlook()
i = SendMessage(3)
End Sub
'*** Called by buttons on the conflict sheet
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Sub EmailConflictUrgent()
'*** Emergency Conflict
Dim i As Integer
On Error Resume Next
Kill TMP_FILE
SetClientCell (3)
i = GetOutlook()
i = SendMessage(2)
End Sub
'*** Called by buttons on the conflict sheet
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Sub EmailConflictNormal()
'*** Normal Conflict
Dim i As Integer
On Error Resume Next
Kill TMP_FILE
SetClientCell (3)
i = GetOutlook()
i = SendMessage(0)
End Sub
' Module contains only 2 methods:
' 1) GetOutlook()
' 2) SendMessage()
'*** Called by EmailConflictConfidential(), EmailConflictUrgent(), EmailConflictNormal()
'*** -----------------------------------------------------------------------------------------
Private Function GetOutlook() As Boolean
' The GetOutlook() function sets the Outlook Application
' and Namespase objects and opens MS Outlook
On Error Resume Next
' Assume success
fSuccess = True
Set mOutlookApp = GetObject("", "Outlook.application")
' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
Err.Clear
Set mOutlookApp = CreateObject("Outlook.application")
If Err.Number > 0 Then
MsgBox "Could not create Outlook object", vbCritical
fSuccess = False
Exit Function
End If
End If
' If we've made it this far, we have an Outlook App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
If Err.Number > 0 Then
MsgBox "Could not create NameSpace object", vbCritical
fSuccess = False
Exit Function
End If
' Return the Success Flag as the value of GetOutlook()
GetOutlook = fSuccess
End Function
'*** Creates an email in html format and attach current workbook to email
'*** iMsgType:
'*** 0 - New Client Conflict
'*** 1 - Extremely Confidential
'*** 2 - Urgent Conflicts
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Public Function SendMessage(iMsgType As Integer) As Boolean
' The SendMessage() function reads user entered values and
' actually sends the message.
On Error GoTo ERR_SendMessage
Dim strRecip As String
Dim strSubject As String
Dim strMsg As String
' Assume success
fSuccess = True
' Here's where the real Outlook Automation takes place
If GetOutlook = True Then
Set mItem = mOutlookApp.CreateItem(olMailItem)
mItem.Recipients.Add strRecip
' mItem.Subject = arrSubject(iMsgType)
mItem.Body = strMsg
End If
ERR_SendMessage:
MsgBox "Error from SendMessage(): " & Err.Description, vbOKOnly, "Error composing email"
fSuccess = False
End Function
I have what I hope is a fairly simple question. I have a template from Office 2003 that I need to convert to 2007. The purpose of the template is to allow a user to open it, fill it out, and then open an email (that they will click to send) that contains the contents of the workbook (in HTML) as well as an attachment of the file.
In 2003, it works perfectly.
In 2007, I have "issues"
When using excel 2007 to work with the template, any time I click one of the buttons (urgent, confidential,normal - all this really does is change the subject and priority when creating the email) I get an error "Application Defined or Object-Defined error" in the SendMail() function
I have enabled all macros in the trust center for outlook and excel. It has not seemed to make a difference. This makes me think something changed in the VBA.
Its not a really long piece of code, but its long enough. If anyone would be willing to take a look, I would greatly appreciate it. (I also posted this on the msdn board)
If anyone is willing, I could provide the template itself to take a look at.
'*** Declare module level variables
Option Explicit
'Dim mOutlookApp As Outlook.Application
'Dim mNameSpace As Outlook.NameSpace
'Dim mItem As Outlook.MailItem
Dim mOutlookApp As Object
Dim mNameSpace As Object
Dim mItem As Object
Dim fSuccess As Boolean
Const TMP_FILE As String = "C:\Conflict01.xlsx" '*** used by SendMessage()
'***--------------------------------------------------------------------------
'*** Called by buttons on the conflict sheet
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Sub EmailConflictConfidential()
'*** Extremely Confidential
Dim i As Integer
Dim sClientCell As String
Dim sAddStr As String
On Error Resume Next
sAddStr = TMP_FILE
Kill sAddStr
i = GetOutlook()
'smwm - takes care of the client name and importance label
SetClientCell (1)
i = SendMessage(1)
End Sub
Sub SetClientCell(intClientType As Integer)
'Takes care of the client name and importance label
'1 = Extremely Confidential
'2 = Extremely Urgent and Confidential
'3 = Normal
Dim strConfidential As String
Dim strUrgentConfidential As String
Dim strClient As String
Dim intLengthConfidential As Integer
Dim intLengthUrgentConfidential As Integer
strConfidential = "EXTREMELY CONFIDENTIAL - "
strUrgentConfidential = "EXTREMELY URGENT AND CONFIDENTIAL - "
intLengthConfidential = Len(strConfidential)
intLengthUrgentConfidential = Len(strUrgentConfidential)
strClient = ActiveSheet.Range("B13").Value
If InStr(strClient, strConfidential) <> 0 Then
strClient = Mid(strClient, intLengthConfidential, Len(strClient))
ElseIf InStr(strClient, strUrgentConfidential) <> 0 Then
strClient = Mid(strClient, intLengthUrgentConfidential, Len(strClient))
End If
If intClientType = 1 Then
strClient = strConfidential & strClient
ElseIf intClientType = 2 Then
strClient = strUrgentConfidential & strClient
End If
ActiveSheet.Range("B13").Value = strClient
End Sub
'*** Called by buttons on the conflict sheet
'*** 2/9/06 Sarah Maston
'***----------------------------------------
Sub EmailConflictUrgentConfidential()
'*** Emergency Conflict
Dim i As Integer
Dim sClientCell As String
Dim sAddStr As String
On Error Resume Next
sAddStr = TMP_FILE
Kill sAddStr
'smwm - takes care of the client name and importance label
SetClientCell (2)
i = GetOutlook()
i = SendMessage(3)
End Sub
'*** Called by buttons on the conflict sheet
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Sub EmailConflictUrgent()
'*** Emergency Conflict
Dim i As Integer
On Error Resume Next
Kill TMP_FILE
SetClientCell (3)
i = GetOutlook()
i = SendMessage(2)
End Sub
'*** Called by buttons on the conflict sheet
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Sub EmailConflictNormal()
'*** Normal Conflict
Dim i As Integer
On Error Resume Next
Kill TMP_FILE
SetClientCell (3)
i = GetOutlook()
i = SendMessage(0)
End Sub
' Module contains only 2 methods:
' 1) GetOutlook()
' 2) SendMessage()
'*** Called by EmailConflictConfidential(), EmailConflictUrgent(), EmailConflictNormal()
'*** -----------------------------------------------------------------------------------------
Private Function GetOutlook() As Boolean
' The GetOutlook() function sets the Outlook Application
' and Namespase objects and opens MS Outlook
On Error Resume Next
' Assume success
fSuccess = True
Set mOutlookApp = GetObject("", "Outlook.application")
' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
Err.Clear
Set mOutlookApp = CreateObject("Outlook.application")
If Err.Number > 0 Then
MsgBox "Could not create Outlook object", vbCritical
fSuccess = False
Exit Function
End If
End If
' If we've made it this far, we have an Outlook App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
If Err.Number > 0 Then
MsgBox "Could not create NameSpace object", vbCritical
fSuccess = False
Exit Function
End If
' Return the Success Flag as the value of GetOutlook()
GetOutlook = fSuccess
End Function
'*** Creates an email in html format and attach current workbook to email
'*** iMsgType:
'*** 0 - New Client Conflict
'*** 1 - Extremely Confidential
'*** 2 - Urgent Conflicts
'*** 10/27/04 Ai Lean Lim
'***----------------------------------------
Public Function SendMessage(iMsgType As Integer) As Boolean
' The SendMessage() function reads user entered values and
' actually sends the message.
On Error GoTo ERR_SendMessage
Dim strRecip As String
Dim strSubject As String
Dim strMsg As String
' Assume success
fSuccess = True
' Here's where the real Outlook Automation takes place
If GetOutlook = True Then
Set mItem = mOutlookApp.CreateItem(olMailItem)
mItem.Recipients.Add strRecip
' mItem.Subject = arrSubject(iMsgType)
mItem.Body = strMsg
End If
ERR_SendMessage:
MsgBox "Error from SendMessage(): " & Err.Description, vbOKOnly, "Error composing email"
fSuccess = False
End Function