Redemption, Help with selecting E-mail Account
 

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

Redemption, Help with selecting E-mail Account
 

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

Redemption, Help with selecting E-mail Account
 

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

Redemption, Help with selecting E-mail Account
 

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

Redemption, Help with selecting E-mail Account
 

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"

Redemption, Help with selecting E-mail Account
 

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"

Redemption, Help with selecting E-mail Account
 

Thanks Ken, registered Redemption and dialog box popped up and said it
was a successful install (it was in path c:\program files\redemption
\redemption.dll, however when I ran the code, it debugged on line

Session.MAPIOBJECT = oNS.MAPIOBJECT, highlighting the word .MAPIOBJECT

Again with debug message was "method or data method not found"

Running under Windows server 2003 using Office 2003

Redemption, Help with selecting E-mail Account
 

Weird. On which MAPIOBJECT did it choke? If you right-click on the
right-pane in the Object Browser and select Show Hidden Members you will see
that NameSpace.MAPIOBJECT is there but it's normally hidden.
RDOSession.MAPIOBJECT isn't a hidden member, it's exposed.

You do have a reference set to Redemption in your VBA project references?

See if it works any better using late binding. Declare both the NameSpace
and RDOSession objects as Object and then see if you get the same error.

--
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
...
Thanks Ken, registered Redemption and dialog box popped up and said it
was a successful install (it was in path c:\program files\redemption
\redemption.dll, however when I ran the code, it debugged on line

Session.MAPIOBJECT = oNS.MAPIOBJECT, highlighting the word .MAPIOBJECT

Again with debug message was "method or data method not found"

Running under Windows server 2003 using Office 2003

Redemption, Help with selecting E-mail Account
 

What does
MsgBox TypeName(oNS)
show?

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"Sean" wrote in message
...
Thanks Ken, registered Redemption and dialog box popped up and said it
was a successful install (it was in path c:\program files\redemption
\redemption.dll, however when I ran the code, it debugged on line

Session.MAPIOBJECT = oNS.MAPIOBJECT, highlighting the word .MAPIOBJECT

Again with debug message was "method or data method not found"

Running under Windows server 2003 using Office 2003

Redemption, Help with selecting E-mail Account
 

Ken, when I right click on debug message, it shows Mapiutils under
classes and I can see MAPIIOBJECT under members, although don't know
what all that means

I declared what you said as
Dim NameSpace As Object
Dim RDOSession As Object

But it debugs with the exact same message.

I've looked at the Redemption site and under FAQ # 14 it seems to do
exactly what I want my means of "hard coding" a From name and addy,
the text of it is below, but how would I incorporate that to twaek my
code, on the assumption that I can't get above to work

Is there any way I can select an account to be used for sending a
message with Redemption?

Generally speaking, no. If you look at the message sent using non-
default account using OutlookSpy, you will notice that Outlooks sets a
couple of named properties; one of them is the name of the account,
another one is a combination of the account integer index and its
name. The format is not documented of course.

The good news however is that you can do much better than just
selecting an account: you can set the sender name and address to an
arbitrary value, you do not need to have an account configured with
that name and address. The trick is based on the fact that you can add
a named property with a particular GUID to an outgoing message and
force Outlook to use the name of the property as an RC822 header and
its value as the value of the header. By adding a property with the
name "From" and the value in the form "Someone "
you add an RF822 header:

From: Someone

Both Exchange and IMAIL providers are smart enough to replace an
existing header if one exists, i.e. you will not get two "From"
headers. The only limitation is that the message must be converted to
the RFC822 format along the way, it will not work if the message is
sent between two mailboxes on the same Exchange server. The message in
your Sent Items folder will still have the default sender name, but
the recipients will see the new value. Whether you use IMAIL (POP3/
SMTP) or Exchange provider in Outlook to send a message, doesn't
matter at all, it will work in both cases.

set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = MailItem
tag = sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}",
"From")
tag = tag or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = "Someone "
sItem.Subject = sItem.Subject 'to trick Outlook into thinking that
something has changed
sItem.Save

Redemption, Help with selecting E-mail Account
 

Using the x-header trick or using RDOMail.Account are roughly equivalent.

I'd concentrate on getting what you have to work though, unless you do any
alternate code would probably also fail.

What's the answer to Dmitry's question? He's the expert in Redemption, after
all he wrote it. I've just used it every day for the last 6 years or so, so
his help in this will be invaluable.

--
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, when I right click on debug message, it shows Mapiutils under
classes and I can see MAPIIOBJECT under members, although don't know
what all that means

I declared what you said as
Dim NameSpace As Object
Dim RDOSession As Object

But it debugs with the exact same message.

I've looked at the Redemption site and under FAQ # 14 it seems to do
exactly what I want my means of "hard coding" a From name and addy,
the text of it is below, but how would I incorporate that to twaek my
code, on the assumption that I can't get above to work

Is there any way I can select an account to be used for sending a
message with Redemption?

Generally speaking, no. If you look at the message sent using non-
default account using OutlookSpy, you will notice that Outlooks sets a
couple of named properties; one of them is the name of the account,
another one is a combination of the account integer index and its
name. The format is not documented of course.

The good news however is that you can do much better than just
selecting an account: you can set the sender name and address to an
arbitrary value, you do not need to have an account configured with
that name and address. The trick is based on the fact that you can add
a named property with a particular GUID to an outgoing message and
force Outlook to use the name of the property as an RC822 header and
its value as the value of the header. By adding a property with the
name "From" and the value in the form "Someone "
you add an RF822 header:

From: Someone

Both Exchange and IMAIL providers are smart enough to replace an
existing header if one exists, i.e. you will not get two "From"
headers. The only limitation is that the message must be converted to
the RFC822 format along the way, it will not work if the message is
sent between two mailboxes on the same Exchange server. The message in
your Sent Items folder will still have the default sender name, but
the recipients will see the new value. Whether you use IMAIL (POP3/
SMTP) or Exchange provider in Outlook to send a message, doesn't
matter at all, it will work in both cases.

set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = MailItem
tag = sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}",
"From")
tag = tag or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = "Someone "
sItem.Subject = sItem.Subject 'to trick Outlook into thinking that
something has changed
sItem.Save

Redemption, Help with selecting E-mail Account
 

Hi Dmitry, I'm a lay man in IT terms so not sure what you mean, but
guess its-

Sub Test()
MsgBox TypeName(oNS)

End Sub

Result of above is "Empty"

Redemption, Help with selecting E-mail Account
 

No, I mean instead of making it a sub, insert the message box into the code
that uses the oNS variable. In your sub, oNS is undefined, hence you get
"empty".
Insert
MsgBox TypeName(oNS)
just above the line
Session.MAPIOBJECT = oNS.MAPIOBJECT

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"Sean" wrote in message
...
Hi Dmitry, I'm a lay man in IT terms so not sure what you mean, but
guess its-

Sub Test()
MsgBox TypeName(oNS)

End Sub

Result of above is "Empty"

Redemption, Help with selecting E-mail Account
 

Gotcha, I did that an it still debugged, Message box didn't even show.
I tested it on two different line placements and it debugged on the
same line with no message box displayed on either

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

and

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

Redemption, Help with selecting E-mail Account
 

Does your code instantiate oNS? For example:

Set oNS = olApp.GetNameSpace("MAPI")

--
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
...
Gotcha, I did that an it still debugged, Message box didn't even show.
I tested it on two different line placements and it debugged on the
same line with no message box displayed on either

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

and

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

Redemption, Help with selecting E-mail Account
 

Ken, it didn't, but I entered the line but just debugs on same line

Redemption, Help with selecting E-mail Account
 

Then I'm out of ideas. Do you now get a valid NameSpace object if you test
oNS?

--
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, it didn't, but I entered the line but just debugs on same line

Redemption, Help with selecting E-mail Account
 

Ken, same debug message. I'm happy to e-mail the file, if you want
confirmation or otherwise

Redemption, Help with selecting E-mail Account
 

If NameSpace is still returning Empty then something is really wrong after
you execute the line Set oNS = olApp.GetNameSpace("MAPI"), assuming olApp or
whatever your Application object is called is instantiated. Do you get any
errors on that Set oNS line? Step the code and comment out your error
handler to check that.

--
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, same debug message. I'm happy to e-mail the file, if you want
confirmation or otherwise

Redemption, Help with selecting E-mail Account
 

Ken, best thing I can do is post the full code as it is again

Sub Mail_New_Version()
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
Dim oNS As Outlook.NameSpace
Dim NameSpace As Object
Dim RDOSession As Object
Set oNS = olApp.GetNamespace("MAPI")



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

Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("Mail", "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


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-
mmm-yy h-mm")



ActiveWindow.TabRatio = 0.908


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")



MsgBox TypeName(oNS)

Session.MAPIOBJECT = oNS.MAPIOBJECT

Set Account = Session.Accounts("ABC 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
.Save
Dim sID As String
sID = .EntryID
End With
Set Msg = Session.GetItemFromID(sID)
Msg.Account = Account
.Subject = .Subject
.Save
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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

Redemption, Help with selecting E-mail Account
 

And where is olApp declared and instantiated? You have:

Set oNS = olApp.GetNamespace("MAPI")

but I don't see where olApp is created and instantiated. It looks like
you're actually using OutApp and instantiating it in the Mail_New_Version()
procedure, but after you try to use oNS, so at that point both OutApp and
olApp are Nothing.

Move your code that sets OutApp and oNS to before you try to use the
objects.

Comment out the On Error Resume Next line. Then step your code and make sure
you are getting a valid Outlook.Application object after the line Set OutApp
= CreateObject("Outlook.Application"). Make sure that oNS is valid after
executing the line Set oNS = OutApp.GetNamespace("MAPI").

--
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, best thing I can do is post the full code as it is again

Sub Mail_New_Version()
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
Dim oNS As Outlook.NameSpace
Dim NameSpace As Object
Dim RDOSession As Object
Set oNS = olApp.GetNamespace("MAPI")



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

Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("Mail", "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


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-
mmm-yy h-mm")



ActiveWindow.TabRatio = 0.908


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")



MsgBox TypeName(oNS)

Session.MAPIOBJECT = oNS.MAPIOBJECT

Set Account = Session.Accounts("ABC 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
.Save
Dim sID As String
sID = .EntryID
End With
Set Msg = Session.GetItemFromID(sID)
Msg.Account = Account
.Subject = .Subject
.Save
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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

Redemption, Help with selecting E-mail Account
 

Ken, thanks for your reply, however I'm unsure of exactly what you
mean. I'm not an IT person and my original excel vb was taken from a
standard e-mail post (which worked), so I'm not clear how to
incorporate the redemption element to achieve what I am looking for

Redemption, Help with selecting E-mail Account
 

Please post some of the preceeding thread when you reply, it makes it much
harder to follow the thread otherwise.

At some point, IT person or not, you're going to need to be able to step
your code and debug things to get things working the way you want. I'd
recommend buying a good beginner VBA book so you know how to do the basics.

You really should have something in the To field, a lot of email programs
will consider an email with only Bcc as a spam. Also, usually it's best to
set a Recipient object as olBCC instead of the way it's being done here.

I haven't tested this code. I cleaned up undeclared Outlook and Redemption
objects, released them all, and merged the Outlook and Redemption code
together. Anything else is your responsibility.

Sub Mail_New_Version()
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 Outlook.Application
Dim OutMail As Outlook.MailItem
Dim sh As Worksheet
Dim oNS As Outlook.NameSpace
Dim oSession As Redemption.RDOSession
Dim oAccount As Redemption.RDOAccount
Dim sID As String
Dim Msg As Redemption.RDOMail

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

Set Sourcewb = ActiveWorkbook

'Copy the sheets to a new workbook
Sourcewb.Sheets(Array("Mail", "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


'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-
mmm-yy h-mm")



ActiveWindow.TabRatio = 0.908


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 OutApp = CreateObject("Outlook.Application")
Set oNS = OutApp.GetNamespace("MAPI")
oNS.Logon
Set OutMail = OutApp.CreateItem(0)

Set oSession = CreateObject("Redemption.RDOSession")

MsgBox TypeName(oNS)

oSession.MAPIOBJECT = oNS.MAPIOBJECT

Set oAccount = oSession.Accounts("ABC Reporting")

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

.Save
sID = .EntryID

Set Msg = oSession.GetMessageFromID(sID)
Msg.Account = oAccount

.Subject = .Subject
.Save

.Send
End With

On Error GoTo 0
.Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set Sourcewb = Nothing
Set Destwb = Nothing
Set sh = Nothing

Set oAccount = Nothing
Set Msg = Nothing

oSession.Logoff
Set oSession = Nothing

Set OutMail = Nothing
Set oNS = Nothing

OutApp.Quit
Set OutApp = Nothing

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


--
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, thanks for your reply, however I'm unsure of exactly what you
mean. I'm not an IT person and my original excel vb was taken from a
standard e-mail post (which worked), so I'm not clear how to
incorporate the redemption element to achieve what I am looking for