Upgrading VB6 code from Outlook 2007 to Outlook 2010
We want to upgrade our VB6 code to use Outlook 2010, but we're getting the following error:
Active x cannot create object
This is our current code:
Public Sub SendEmail()
Set emailOutlookApp = CreateObject("Outlook.Application.12")
Set emailNameSpace = emailOutlookA开发者_JAVA技巧pp.GetNamespace("MAPI")
Set emailFolder = emailNameSpace.GetDefaultFolder(olFolderInbox)
Set emailItem = emailOutlookApp.CreateItem(olMailItem)
Set EmailRecipient = emailItem.Recipients
EmailRecipient.Add (EmailAddress)
EmailRecipient.Add (EmailAddress2)
emailItem.Importance = olImportanceHigh
emailItem.Subject = "My Subject"
emailItem.Body = "The Body"
'-----Send the Email-----'
emailItem.Save
emailItem.Send
'-----Clear out the memory space held by variables-----'
Set emailNameSpace = Nothing
Set emailFolder = Nothing
Set emailItem = Nothing
Set emailOutlookApp = Nothing
Exit Sub
I'm not sure if "Outlook.Application.12" is correct. But I can't find a definitive answer for this.
For Outlook 2010, this is definitly corect Outlook.Application.14
.
But, I don't know what about office 2007.
I think it's Outlook.Application.12
and for lower versions it is simply "Outlook.Application".
Here's the code I switched to for 2010:
Private Sub EmailBlahbutton_Click()
Dim mOutlookApp As Object
Dim OutMail As Object
Dim Intro As String
On Error GoTo ErrorHandler
Set mOutlookApp = GetObject("", "Outlook.application")
Set OutMail = mOutlookApp.CreateItem(0)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'These are the ranges being emailed.
ActiveSheet.Range(blahblahblah).Select
'Intro is the first line of the email
Intro = "BLAHBLAHBLHA"
'Set the To and Subject lines. Send the message.
With OutMail
.To = "blahblah@blah.com"
.Subject = "More BLAH here"
.HTMLBody = Intro & RangetoHTML(Selection)
.Send
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
ActiveSheet.Range("A1").Select
ActiveWindow.ScrollColumn = ActiveCell.Column
ActiveWindow.ScrollRow = ActiveCell.Row
Set OutMail = Nothing
Set mOutlookApp = Nothing
Exit Sub
ErrorHandler:
Set mOutlookApp = CreateObject("Outlook.application")
Resume Next
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Why do you explicitly specify the version? Why not simply Set emailOutlookApp = CreateObject("Outlook.Application")
Try "Outlook.Application.14"
. Not sure if this is related though: 2007 to 2010 upgrade issue
I realize it's not the exact issue, but it may lead you down the right path.
精彩评论