How to make sure output to outlook express not MS outlook

[chinfk]

In my program, i had set that report to be output as an attachment in the email.

But recently, one of the user find that it output by using Microsoft outlook rather than previous one which use outlook express.

How to switch it back to outlook express ?

The program code as below :

DoCmd.SendObject acSendReport, "PhoneBillMaster-tmp-rpt", acFormatRTF, , "[e-mail]", , "Telephone Bill Charges - Usage Date : " & txtStartDate & " - " & txtEndDate, , False

Please help.

Thanks.

[JustJim]

In my program, i had set that report to be output as an attachment in the email.

But recently, one of the user find that it output by using Microsoft outlook rather than previous one which use outlook express.

How to switch it back to outlook express ?

The program code as below :

DoCmd.SendObject acSendReport, "PhoneBillMaster-tmp-rpt", acFormatRTF, , "[e-mail]", , "Telephone Bill Charges - Usage Date : " & txtStartDate & " - " & txtEndDate, , False

Please help.

Thanks.

Perhaps someone else will know more, but I think that SendObject only activates the default e-mail application. (All it says in the un-help file is "the appropriate software is opened"). You may be able to change the default e-mail application in code (like you change the default printer maybe?) but I'm not sure about that.

Do watch that "False" on the end of the command. Some networks get nervous if you try to send an e-mail programaticaly without opening the e-mail application.

Jim

[chinfk]

Hi Jim,

I do chanhe the default email in the IE to outlook express and remove the outlook program as well. But when run the program, it will then prompt for mail
profiles instead.

Maybe there is other place to change default email software in the registry or
maybe have to create a profiles for it.

Any ideal ?

[JustJim]

Hi Jim,

I do chanhe the default email in the IE to outlook express and remove the outlook program as well. But when run the program, it will then prompt for mail
profiles instead.

Maybe there is other place to change default email software in the registry or
maybe have to create a profiles for it.

Any ideal ?

No, sorry. Out of my depth there. I don't mess with the registry, I'm not good enough!

Jim

[chinfk]

Jim,

I have find in the net which provide the solution for the code below.
But I have yet to try to combine it with the docmd.sendobject because
it have errors. Please take a look of it.

----- start of module code -----
Option Compare Database
Option Explicit

Private Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As Long
End Type

Private Type MAPIFileDesc
Reserved As Long
flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type

Private Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Originator As Long
flags As Long
RecipCount As Long
Recipients As Long
FileCount As Long
Files As Long
End Type

Private Declare Function MAPISendMail _
Lib "c:\program files\outlook express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long

Public Function SendMailWithOE( _
ByVal pstrSubject As String, _
ByVal pstrMessage As String, _
Optional ByRef pstrRecipientsTo As String, _
Optional ByRef pstrRecipientsCC As String, _
Optional ByRef pstrRecipientsBCC As String, _
Optional ByVal pstrFiles As String, _
Optional ByVal pblnDisplayMessage As Boolean = True) _
As Long

On Error GoTo Err_Handler

Dim aFiles() As String
Dim aRecips() As String

Dim FilePaths() As MAPIFileDesc
Dim Recips() As MapiRecip
Dim Message As MAPIMessage
Dim lngFlags As Long

Dim lngRC As Long
Dim z As Long

Dim iLastRecip As Integer

If pstrFiles <> vbNullString Then
aFiles = Split(pstrFiles, ",")
ReDim FilePaths(LBound(aFiles) To UBound(aFiles))
For z = LBound(aFiles) To UBound(aFiles)
With FilePaths(z)
.Position = -1
.PathName = StrConv(aFiles(z), vbFromUnicode)
End With
Next z
Message.FileCount = UBound(FilePaths) - LBound(FilePaths) + 1
Message.Files = VarPtr(FilePaths(LBound(FilePaths)))
Else
Message.FileCount = 0
End If

iLastRecip = -1

If Len(pstrRecipientsTo) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsTo, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 1
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

If Len(pstrRecipientsCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

If Len(pstrRecipientsBCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsBCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

With Message
.NoteText = pstrMessage
.RecipCount = UBound(Recips) - LBound(Recips) + 1
.Recipients = VarPtr(Recips(LBound(Recips)))
.Subject = pstrSubject
End With

If pblnDisplayMessage = True Then
lngFlags = MAPI_DIALOG
Else
lngFlags = 0
End If

SendMailWithOE = MAPISendMail(0, 0, Message, lngFlags, 0)

Exit_Point:
Exit Function

Err_Handler:
subDisplayAndLogError "SendMailWithOE", Err.Number, Err.Description
Resume Exit_Point

End Function
'----- end of module code -----


Thanks.

[JustJim]

Jim,

I have find in the net which provide the solution for the code below.
But I have yet to try to combine it with the docmd.sendobject because
it have errors. Please take a look of it.

----- start of module code -----
Option Compare Database
Option Explicit

Private Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As Long
End Type

Private Type MAPIFileDesc
Reserved As Long
flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type

Private Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Originator As Long
flags As Long
RecipCount As Long
Recipients As Long
FileCount As Long
Files As Long
End Type

Private Declare Function MAPISendMail _
Lib "c:\program files\outlook express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long

Public Function SendMailWithOE( _
ByVal pstrSubject As String, _
ByVal pstrMessage As String, _
Optional ByRef pstrRecipientsTo As String, _
Optional ByRef pstrRecipientsCC As String, _
Optional ByRef pstrRecipientsBCC As String, _
Optional ByVal pstrFiles As String, _
Optional ByVal pblnDisplayMessage As Boolean = True) _
As Long

On Error GoTo Err_Handler

Dim aFiles() As String
Dim aRecips() As String

Dim FilePaths() As MAPIFileDesc
Dim Recips() As MapiRecip
Dim Message As MAPIMessage
Dim lngFlags As Long

Dim lngRC As Long
Dim z As Long

Dim iLastRecip As Integer

If pstrFiles <> vbNullString Then
aFiles = Split(pstrFiles, ",")
ReDim FilePaths(LBound(aFiles) To UBound(aFiles))
For z = LBound(aFiles) To UBound(aFiles)
With FilePaths(z)
.Position = -1
.PathName = StrConv(aFiles(z), vbFromUnicode)
End With
Next z
Message.FileCount = UBound(FilePaths) - LBound(FilePaths) + 1
Message.Files = VarPtr(FilePaths(LBound(FilePaths)))
Else
Message.FileCount = 0
End If

iLastRecip = -1

If Len(pstrRecipientsTo) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsTo, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 1
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

If Len(pstrRecipientsCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

If Len(pstrRecipientsBCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsBCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

With Message
.NoteText = pstrMessage
.RecipCount = UBound(Recips) - LBound(Recips) + 1
.Recipients = VarPtr(Recips(LBound(Recips)))
.Subject = pstrSubject
End With

If pblnDisplayMessage = True Then
lngFlags = MAPI_DIALOG
Else
lngFlags = 0
End If

SendMailWithOE = MAPISendMail(0, 0, Message, lngFlags, 0)

Exit_Point:
Exit Function

Err_Handler:
subDisplayAndLogError "SendMailWithOE", Err.Number, Err.Description
Resume Exit_Point

End Function
'----- end of module code -----


Thanks.

I looked, I'm impressed, I'm not analysing it for you!
Copy it and paste it in, try it out. What's the worst that could happen? OK the worst that could happen is that smoke comes out of your computer, but it's unlikely!

Jim

[chinfk]

Hi Jim,

Come on, don't be stingy. Share your knowledge ... =)

Cheers.

[JustJim]

Hi Jim,

Come on, don't be stingy. Share your knowledge ... =)

Cheers.

Seriously, I'm out of my depth here. Not waving, drowning!

Jim

[Jim Doherty]

Jim,

I have find in the net which provide the solution for the code below.
But I have yet to try to combine it with the docmd.sendobject because
it have errors. Please take a look of it.

----- start of module code -----
Option Compare Database
Option Explicit

Private Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As Long
End Type

Private Type MAPIFileDesc
Reserved As Long
flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type

Private Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Originator As Long
flags As Long
RecipCount As Long
Recipients As Long
FileCount As Long
Files As Long
End Type

Private Declare Function MAPISendMail _
Lib "c:\program files\outlook express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long

Public Function SendMailWithOE( _
ByVal pstrSubject As String, _
ByVal pstrMessage As String, _
Optional ByRef pstrRecipientsTo As String, _
Optional ByRef pstrRecipientsCC As String, _
Optional ByRef pstrRecipientsBCC As String, _
Optional ByVal pstrFiles As String, _
Optional ByVal pblnDisplayMessage As Boolean = True) _
As Long

On Error GoTo Err_Handler

Dim aFiles() As String
Dim aRecips() As String

Dim FilePaths() As MAPIFileDesc
Dim Recips() As MapiRecip
Dim Message As MAPIMessage
Dim lngFlags As Long

Dim lngRC As Long
Dim z As Long

Dim iLastRecip As Integer

If pstrFiles <> vbNullString Then
aFiles = Split(pstrFiles, ",")
ReDim FilePaths(LBound(aFiles) To UBound(aFiles))
For z = LBound(aFiles) To UBound(aFiles)
With FilePaths(z)
.Position = -1
.PathName = StrConv(aFiles(z), vbFromUnicode)
End With
Next z
Message.FileCount = UBound(FilePaths) - LBound(FilePaths) + 1
Message.Files = VarPtr(FilePaths(LBound(FilePaths)))
Else
Message.FileCount = 0
End If

iLastRecip = -1

If Len(pstrRecipientsTo) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsTo, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 1
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

If Len(pstrRecipientsCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

If Len(pstrRecipientsBCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsBCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If

With Message
.NoteText = pstrMessage
.RecipCount = UBound(Recips) - LBound(Recips) + 1
.Recipients = VarPtr(Recips(LBound(Recips)))
.Subject = pstrSubject
End With

If pblnDisplayMessage = True Then
lngFlags = MAPI_DIALOG
Else
lngFlags = 0
End If

SendMailWithOE = MAPISendMail(0, 0, Message, lngFlags, 0)

Exit_Point:
Exit Function

Err_Handler:
subDisplayAndLogError "SendMailWithOE", Err.Number, Err.Description
Resume Exit_Point

End Function
'----- end of module code -----


Thanks.

Here is your code debugged with the relevant lines amended being bolded it should now work for you so you can drop the DoCmd.SendObject method in favour of this using this call

 Dim X 
X = SendMailWithOE("test", "test message", [e-mail], "", "", "C:\test.txt", True)
 
 
 

Incidentally in answer to your original posting to ensure that Outlook express actually remains your email client in those situations where it might get changed in favour of outlook as has been already pointed out does require amending the registry. You have to flick over the \HKEY_LOCAL_MACHINE\Software\Clients\mail key from its default if it says Microsoft Outlook to read Outlook Express. There are lots of example modules on the web for manipulating the registry where you read from and write to it. Registry editing It is not for the faint hearted though so be careful. How when and why you would want to do this largely depends on your working environment ie if you are on a network? roaming profiles that maybe overwrite any local settings etc etc.


Regards

Jim :)

 Option Explicit 
Private Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As Long
End Type
Private Type MAPIFileDesc
Reserved As Long
flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type
Private Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Originator As Long
flags As Long
RecipCount As Long
Recipients As Long
FileCount As Long
Files As Long
End Type
 
 Private Const MAPI_DIALOG As Integer = &H8
 
Private Declare Function MAPISendMail _
Lib "c:\program files\outlook express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long
Public Function SendMailWithOE( _
ByVal pstrSubject As String, _
ByVal pstrMessage As String, _
Optional ByRef pstrRecipientsTo As String, _
Optional ByRef pstrRecipientsCC As String, _
Optional ByRef pstrRecipientsBCC As String, _
Optional ByVal pstrFiles As String, _
Optional ByVal pblnDisplayMessage As Boolean = True) _
As Long
On Error GoTo Err_Handler
Dim aFiles() As String
Dim aRecips() As String
Dim FilePaths() As MAPIFileDesc
Dim Recips() As MapiRecip
Dim Message As MAPIMessage
Dim lngFlags As Long
Dim lngRC As Long
Dim z As Long
Dim iLastRecip As Integer
If pstrFiles <> vbNullString Then
aFiles = Split(pstrFiles, ",")
ReDim FilePaths(LBound(aFiles) To UBound(aFiles))
For z = LBound(aFiles) To UBound(aFiles)
With FilePaths(z)
.Position = -1
.PathName = StrConv(aFiles(z), vbFromUnicode)
End With
Next z
Message.FileCount = UBound(FilePaths) - LBound(FilePaths) + 1
Message.Files = VarPtr(FilePaths(LBound(FilePaths)))
Else
Message.FileCount = 0
End If
iLastRecip = -1
If Len(pstrRecipientsTo) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsTo, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 1
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If
If Len(pstrRecipientsCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If
If Len(pstrRecipientsBCC) > 0 Then
Erase aRecips
aRecips = Split(pstrRecipientsBCC, ",")
ReDim Preserve Recips(0 To (iLastRecip + 1 + UBound(aRecips)))
For z = LBound(aRecips) To UBound(aRecips)
iLastRecip = iLastRecip + 1
With Recips(iLastRecip)
.RecipClass = 2
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z
End If
With Message
.NoteText = pstrMessage
.RecipCount = UBound(Recips) - LBound(Recips) + 1
.Recipients = VarPtr(Recips(LBound(Recips)))
.Subject = pstrSubject
End With
If pblnDisplayMessage = True Then
lngFlags = MAPI_DIALOG
Else
lngFlags = 0
End If
SendMailWithOE = MAPISendMail(0, 0, Message, lngFlags, 0)
Exit_Point:
Exit Function
Err_Handler:
 MsgBox "SendMailWithOE", Err.Number, Err.Description, vbinformation,"System Message"
Resume Exit_Point
End Function
 

[JustJim]

Thanks Jim

I'da got lost in that lot. Well done

Jim