Email with Outlook Express Problem

[Jim]

I have been using outlook express for some time with
Excel to compose and email and sent it via Outlook Express.

The below listed macros have worked until recently.
The part of the code which does not work is:

ShellExecute 0, "open", MailToURL(sAddy, sSubject, sBody), _
"", "", SW_NORMAL

What does not happen is a new email is not composed. Outlook Express
opens but the composition of a new email does not materialize. I know
it is not the code because it works on another computer. It has
something to do with Outlook Express or one of the dlls I suspect.

Any help would be appreciated.

Thanks,
Jim

Here is all of the code:


Public 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_NORMAL = 1


Public Function MailToURL(sAddy As String, sSubject As String, _
sBody As String)

MailToURL = "mailto:" & URLEncode(sAddy) & "?subject=" & _
URLEncode(sSubject) & "&body=" & URLEncode(sBody)

End Function

Public Function URLEncode(sPlain As String) As String

Dim i As Long

For i = 1 To Len(sPlain)
Select Case Asc(UCase(Mid(sPlain, i, 1)))
Case Asc("A") To Asc("Z")
URLEncode = URLEncode & Mid(sPlain, i, 1)
Case Else
URLEncode = URLEncode & "%" & _
Right("00" & Hex(Asc(Mid(sPlain, i, 1))), 2)
End Select
Next

End Function


Sub SendEmailInvoice()
' Sents a email using Outlook Express. It will open Outlook Express
' and place the email adress from the worksheet in it, the subject
line
' from this procedure, and then copy a worksheet into the clipboard.
' When Outlook Express opens the user pastes the clipboard into the
' body of the Outlook Express Email.

Dim sAddy As String
Dim sSubject As String
Dim sBody As String
Dim FirstCell As String
Dim LastCell As String
Dim MyRange As Range

' Open Outlook Express
Call OpenOutlookExpress

' Wait 2-6 seconds before sending keystrokes, allows Outlook express
to open
'Application.Wait (Now + TimeValue("0:00:06"))
Application.Wait (Now + TimeValue("0:00:05"))


FirstCell = Sheets("Invoice").Range("A1").Address
LastCell = Sheets("Invoice").Range("AB50").Address

Set MyRange = Sheets("Invoice").Range(FirstCell, LastCell)

'' For Each cell In MyRange
'' sBody = sBody & cell.Value & vbCrLf
'' Next cell

' Copying MyRange to the clipboard, all I have to do then is
' paste it into the body of the new email.

MyRange.Copy

sAddy = Sheets("Setup").Range("C33").Value
'sAddy = "(e-mail address removed)"
sSubject = "Invoice #" & Sheets("Invoice").Range("W7").Value
sBody = ""

ShellExecute 0, "open", MailToURL(sAddy, sSubject, sBody), _
"", "", SW_NORMAL




' Wait 2-6 seconds before sending keystrokes, allows Outlook express
to open
'Application.Wait (Now + TimeValue("0:00:06"))
Application.Wait (Now + TimeValue("0:00:04"))

' Tab to the body of the email
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True

' Wait one-two seconds before sending keystrokes
'Application.Wait (Now + TimeValue("0:00:02"))
Application.Wait (Now + TimeValue("0:00:02"))

' Paste data into body of email
Application.SendKeys "^v", True

' Go to top of page
Application.SendKeys "^{PGUP}", True

' Go to position right after "Hi"
Application.SendKeys "{Right}", True
Application.SendKeys "{Right}", True

' Must turn off the paste function or user could accidentially hit
"enter"
Application.CutCopyMode = False

''' Moving back to the Marketing WS
'' Sheets("Marketing").Activate

End Sub

 

[Jim Thomlinson]

Check out this link. Lots of good foolproof ways to send e-mail...

http://www.rondebruin.nl/sendmail.htm