Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email with Outlook Express Problem
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 = " 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email with Outlook Express Problem
Check out this link. Lots of good foolproof ways to send e-mail...
http://www.rondebruin.nl/sendmail.htm -- HTH... Jim Thomlinson "Jim" wrote: 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 = " 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Email value of a cell in Outlook Express | Excel Programming | |||
Email value of a cell in Outlook Express | Excel Programming | |||
Email value of a cell in Outlook Express | Excel Programming | |||
Email value of a cell in Outlook Express | Excel Programming | |||
Email Macro with Outlook Express | Excel Discussion (Misc queries) |