I'm hoping someone can assist me, as I'm a bit lost. I'm trying to
select a particular Outlook account to send out an e-mail message from
Excel. My code that e-mails from Excel works fine, apat from the fact
it selects the default Outlook account to send the e-mail which is not
the one I want. Looking through the forums I'm told Redemption will
allow you to select, so I've installed Redemption but I'm lost as to
how I tweak my code. My original working code is below. It appears
that I need to place the following code somewhere in my code, but I
get a "property is read only" on the first line just below

Set Session = CreateObject("Redemption.RDOSession")
Session.Logon
Set Drafts = Session.GetDefaultFolder(olFolderDrafts)
Set Msg = Drafts.Items.Add
Set Account = Session.Accounts("123 Reporting")
Msg.Account = Account
Msg.Send



Sub Mail_From_Excel()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

Sourcewb.Sheets(Array("Mail", "E-YTD")).Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security
dialog that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-
mmm-yy h-mm")

ActiveWindow.TabRatio = 0.908


Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

For Each cell In ThisWorkbook.Sheets("Mail") _
.Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = strto
.Subject = ThisWorkbook.Sheets("Mail").Range("A1").Value
.Body = ""
.Attachments.Add Destwb.FullName
.ReadReceiptRequested = True
.Importance = 1
.DeferredDeliveryTime =
ThisWorkbook.Sheets("Mail").Range("B1").Value
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Is Redemption registered? Is it referenced in your VBA project? Do you get
any errors when you create the Outlook.Application object? You shouldn't get
that error on CreateObject anyway, are you sure it's on that line?

To integrate the code assign Session.MAPIOBJECT = ns.MAPIOBJECT, where ns =
OutApp.GetNameSpace("MAPI") instead of using Session.Logon. That way
Redemption hooks into the current Outlook session. Then save your mail item
OutMail, get its EntryID and instantiate the Msg object, which I asume is an
RDOMail object, and then play with the Session.Accounts collection.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Sean" wrote in message
...
I'm hoping someone can assist me, as I'm a bit lost. I'm trying to
select a particular Outlook account to send out an e-mail message from
Excel. My code that e-mails from Excel works fine, apat from the fact
it selects the default Outlook account to send the e-mail which is not
the one I want. Looking through the forums I'm told Redemption will
allow you to select, so I've installed Redemption but I'm lost as to
how I tweak my code. My original working code is below. It appears
that I need to place the following code somewhere in my code, but I
get a "property is read only" on the first line just below

Set Session = CreateObject("Redemption.RDOSession")
Session.Logon
Set Drafts = Session.GetDefaultFolder(olFolderDrafts)
Set Msg = Drafts.Items.Add
Set Account = Session.Accounts("123 Reporting")
Msg.Account = Account
Msg.Send



Sub Mail_From_Excel()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

Sourcewb.Sheets(Array("Mail", "E-YTD")).Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security
dialog that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-
mmm-yy h-mm")

ActiveWindow.TabRatio = 0.908


Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

For Each cell In ThisWorkbook.Sheets("Mail") _
.Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum

On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = strto
.Subject = ThisWorkbook.Sheets("Mail").Range("A1").Value
.Body = ""
.Attachments.Add Destwb.FullName
.ReadReceiptRequested = True
.Importance = 1
.DeferredDeliveryTime =
ThisWorkbook.Sheets("Mail").Range("B1").Value
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Ken, thanks for your reply.I haven't registered anything, just
downloaded and installed and it said it was successful. I have
referenced Redemption within the VB and it does hit debug on the line
"Set Session = CreateObject("Redemption.RDOSession")". BTW when I
tested it I placed the redemption part of the code below the lines

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet

But I took it out from my original (working) e-mail from excel macro

I'm a bit lost on your suggested fix, can the code below be placed
anywhere within my code, apart from Msg.send which I assume should be
near the end?

Set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = ns.MAPIOBJECT, where ns =
OutApp.GetNameSpace("MAPI")
Set Drafts = Session.GetDefaultFolder(olFolderDrafts)
Set Msg = Drafts.Items.Add
Set Account = Session.Accounts("123 Reporting")
Msg.Account = Account
Msg.Send

Run regsvr32 on Redemption.dll, then try your code.

I'd use something like this:

' previous code

Dim oNS As Outlook.NameSpace

Set OutApp = CreateObject("Outlook.Application")
Set oNS = OutApp.GetNameSpace("MAPI")
oNS.Logon
Set OutMail = OutApp.CreateItem(0)

For Each cell In ThisWorkbook.Sheets("Mail") _
.Columns("BA").Cells.SpecialCells(xlCellTypeConsta nts)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum

On Error Resume Next

Set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = oNS.MAPIOBJECT

Set Account = Session.Accounts("123 Reporting")
.Account = Account

With OutMail
.To = ""
.CC = ""
.BCC = strto
.Subject = ThisWorkbook.Sheets("Mail").Range("A1").Value
.Body = ""
.Attachments.Add Destwb.FullName
.ReadReceiptRequested = True
.Importance = 1
.DeferredDeliveryTime =
ThisWorkbook.Sheets("Mail").Range("B1").Value

.Save

Dim sID As String
sID = .EntryID
End With


Set Msg = Session.GetItemFromID(sID)
Msg.Account = Account

.Subject = .Subject

.Save

.Send
End With

'rest of the code

Ken, many thanks for taking the time to reply

I'm not quite sure how to Run regsvr32 on Redemption.dll. I entered
"regsvr32 Redemption.dll" on the Run command line but it returned
"LoadLibrary" failed, I'm perhaps doing something wrong.

I then twaeked my code as per your suggestion but hit a debug on line-

Session.MAPIOBJECT = oNS.MAPIOBJECT

It said "Method or Data member not found"

Until Redemption is registered you won't be able to use any Redemption
objects.

Unless where Redemption is installed is in a path statement you will need to
use a full path to that dll. For example, if it's located under Program
Files\Common Files you would use:

regsvr32 "c:\program files\common files\redemption.dll"

Always use quotes if a space is there in the path.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"Sean" wrote in message
...
Ken, many thanks for taking the time to reply

I'm not quite sure how to Run regsvr32 on Redemption.dll. I entered
"regsvr32 Redemption.dll" on the Run command line but it returned
"LoadLibrary" failed, I'm perhaps doing something wrong.

I then twaeked my code as per your suggestion but hit a debug on line-

Session.MAPIOBJECT = oNS.MAPIOBJECT

It said "Method or Data member not found"