Visual Basic Internet Routines
ShellExecute: Send Large Emails in Outlook Express
     
Posted:   Sunday March 10, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows 2000
OS restrictions:   None
Author:   VBnet - Randy Birch, msnews post
     

Related:  

ShellExecute: Simulate a Hyperlink with a Label Control
ShellExecute: ShellExecute Madness 
     
 Prerequisites
A valid email account set up in Outlook Express (see notes below). 

While ShellExecute will send an email via the client's default email client using the mailto: syntax, ShellExecute's lpFile parameter is limited to about 240 characters which doesn't give a lot of room for the To, CC, BCC, Subject and Message data.

However, if you're using Outlook Express, you have a file association to .eml files - the plain-text file format used by OE. By writing a file to disk with the .eml extension containing the expected email-specific fields, an email containing a message of any size can be created. Then, by passing ShellExecute the filename created, rather than the usual mailto: string, the Outlook Express opens a new message containing the complete email.

ShellExecute creates and displays the email on the client system where the user has the ability to alter or add to any of the specified fields before sending the email. In other words, the sending of the email is not transparent and requires user interaction to actually perform the send. To create and send an email transparently, MAPI, the Winsock control, or raw SMTP code must be used. But for simple emails where the client is Outlook Express, nothing beats the ease in integrating this method into an app.

This code writes a file in a format Outlook Express uses, and uses the message file association for Outlook Express (*.eml).  Therefore, because this message format of other email clients may differ from the .eml format, this technique is really only applicable to Outlook Express. It definitely will not work with Microsoft Outlook, which uses a binary file with a *.msg extension.

NOTE: In April 2006 Microsoft released a security patch for Outlook Express that had the unintentional side effect of eliminating OE's ability to open template .eml files (the files opened as a reply, not a message to send). The problem was identified as OE no longer recognizing the X-UNSENT: 1 flag in the header that this demo (and OE template .eml files) relied on. To mitigate this problem MS released a hotfix in May and the "Inside Outlook Express" site released a companion .REG file that also needs to be run in order to restore standard functionality.  I have packaged both the REG file, the hotfix and instructions in the ZIP file downloadable from this link.

 BAS Module Code
None.

 Form Code
To a form add a command button (Command1), and six text boxes (Text1 through Text6) (ignore the combo shown in the illustration; the demo uses a text box). In addition, add three Option buttons in a control array (Option1(0) - Option1(2)), along with the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function ShellExecute Lib "shell32.dll" _
   Alias "ShellExecuteA" _
  (ByVal hwnd As Long, _
   ByVal lpOperation As String, _
   ByVal lpFile As String, _
   ByVal lpParameters As String, _
   ByVal lpDirectory As String, _
   ByVal nShowCmd As Long) As Long
    
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWDEFAULT As Long = 10

Private Type EmailInfo
   sAddrTo As String
   sAddrCC As String
   sAddrBCC As String
   sAddrFrom As String
   sSubject As String
   sMessage As String
   sPriority As Long
End Type
   


Private Sub Form_Load()

   Dim msg As String
   
   Command1.Caption = "Send Email"
   Option1(1).Value = True
   
   Text1.Text = "me@123.com"
   Text2.Text = "recipient@123.com"
   Text3.Text = "ccperson@123.com"
   Text4.Text = "bccperson@123.com"
   Text5.Text = "VBnet ShellExecute Test Message"
   
  'a long message
   msg = msg & "Since beginning VBnet in November of 1996, "
   msg = msg & "I have been repeatedly asked why I don't (or won't) "
   msg = msg & "provide the code methodologies and projects "
   msg = msg & "presented here in a downloadable format like "
   msg = msg & "other sites do." & vbCrLf & vbCrLf
   msg = msg & "The decision to present the site as code (text) "
   msg = msg & "pages instead of zip files was not one that I "
   msg = msg & "made lightly. Frankly, just providing downloadable "
   msg = msg & "files is certainly easier than creating and "
   msg = msg & "maintaining individual pages for each code topic."
   msg = msg & "However, given my reasons below, I believe that "
   msg = msg & "the VBnet text presentation method benefits more "
   msg = msg & "than downloads could." & vbCrLf & vbCrLf
   msg = msg & "Providing the code as HTML pages is not without "
   msg = msg & "its frustrations. There's the issue of HTML and "
   msg = msg & "the 'not equal' signs; HTML interpreters ignore "
   msg = msg & "these VB operators because they expect to find "
   msg = msg & "HTML formatting commands inside. There's the issue "
   msg = msg & "of assuring hard returns are correctly interpreted, "
   msg = msg & "and that non-breaking spaces don't find their "
   msg = msg & "way into the code (which wrecks havoc in the IDE). "
   msg = msg & "Add to this assuring no code from the development "
   msg = msg & "project is inadvertently omitted, all the while "
   msg = msg & "keeping in mind potential compatibility problems "
   msg = msg & "between presentation in Internet Explorer and Netscape."
   msg = msg & vbCrLf & vbCrLf
   msg = msg & "Challenges aside, VBnet provides the opportunity to "
   msg = msg & "share what I have learned pouring through the MSDN "
   msg = msg & "and other API references, and have received from "
   msg = msg & "friends and contributors, as well as the bonus of "
   msg = msg & "allowing me to experiment with web site design. "
   Text6.Text = msg
   
End Sub


Private Sub Command1_Click()

   Dim email As EmailInfo
   Dim msg As String
   Dim sTmpFile As String
   Dim hFile As Long
   
  'the temp email file
   sTmpFile = App.Path & "\temp.eml"
   
  'complete the fields to be used
   With email
      .sAddrFrom = Text1.Text
      .sAddrTo = Text2.Text
      .sAddrCC = Text3.Text
      .sAddrBCC = Text4.Text
      .sSubject = Text5.Text
      .sMessage = Text6.Text
      .sPriority = (GetSelectedOptionIndex() * 2) + 1
   End With
   
  'create the temp file
   hFile = EmailCreate(sTmpFile)
   
  'if successful,
   If hFile <> 0 Then
   
     'write out the data and
     'send the email
      If EmailWrite(hFile, email) Then
      
         RunShellExecute "Open", _
                         sTmpFile, _
                         vbNullString, _
                         vbNullString, _
                         vbNormalFocus
      
      End If
   
   End If
   
End Sub


Private Function GetSelectedOptionIndex() As Long

  'returns the selected item index from
  'an option button array. Use in place
  'of multiple If...Then statements!
  'If your array contains more elements,
  'just append them to the test condition,
  'setting the multiplier to the button's
  'negative -index.
   GetSelectedOptionIndex = Option1(0).Value * 0 Or _
                            Option1(1).Value * -1 Or _
                            Option1(2).Value * -2
End Function



Private Sub RunShellExecute(sAddrTopic As String, _
                           sFile As Variant, _
                           sParams As Variant, _
                           sDirectory As Variant, _
                           nShowCmd As Long)

   Dim hWndDesk As Long
   Dim success As Long
  
  'the desktop will be the
  'default for error messages
   hWndDesk = GetDesktopWindow()
  
  'execute the passed operation
   success = ShellExecute(hWndDesk, _
                          sAddrTopic, _
                          sFile, _
                          sParams, _
                          sDirectory, _
                          nShowCmd)

  'This is optional. Uncomment the three lines
  'below to have the "Open With.." dialog appear
  'when the ShellExecute API call fails
  'If success < 32 Then
  '   Call Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & sFile, vbNormalFocus)
  'End If
   
End Sub


Private Function EmailCreate(sTmpFile) As Long

   Dim hFile As Long
   
   hFile = FreeFile
   Open sTmpFile For Output As #hFile
   
   EmailCreate = hFile
   
End Function


Private Function EmailWrite(ByVal hFile As Long, email As EmailInfo) As Boolean

  'write the email fields to the file
   
   Print #hFile, "From: <"; email.sAddrFrom; ">"
   
   If Len(email.sAddrTo) Then
      Print #hFile, "To: "; Chr$(34); email.sAddrTo; Chr$(34)
   Else
     'no to address, so bail
      EmailWrite = False
      Exit Function
   End If
   
   If Len(email.sAddrCC) Then
      Print #hFile, "CC: "; Chr$(34); email.sAddrCC; Chr$(34)
   End If
      
   If Len(email.sAddrBCC) Then
      Print #hFile, "BCC: "; Chr$(34); email.sAddrBCC; Chr$(34)
   End If
   
   Print #hFile, "Subject: "; email.sSubject
   Print #hFile, "X-Priority:"; email.sPriority   '1=high,3=normal,5=low
   
  'this is the last header line - everything
  'after this appears in the message.
   Print #hFile, "X-Unsent: 1"
   Print #hFile, ""    'Blank line
   Print #hFile, email.sMessage
   
   Close #hFile
   
   EmailWrite = True

End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter