|
Repost
Sorry, I posted this yesterday but didn't get a response. I was hoping to try
again today. Im having a problem trying to figure out why one email function works but another one doesnt. Both codes work on my home computer using Outlook, but when I try to run them at work(we use Lotus Notes) the Sub Mail_Text_in_Body_3() code does not create the message. It seems like it is calling up Lotus Notes but the email message doesnt get created. I have changed the mail server to Lotus Notes in Internet Explorer. The code Mail_ActiveSheet() works fine 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 __________________________________________________ ___________________ Sub Mail_Text_in_Body_3() 'Creates statement for a person and emails it to data entry Dim msg As String, URL As String Dim Recipient As String, Subj As String Dim cell As Range Recipient = "data" Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & " for Incident " & Sheets("Employee List").Range("N7").Value msg = "Statement of " & Sheets("Employee List").Range("Q1").Value & " of My Work" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N3") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") URL = "mailto:" & Recipient & "&subject=" & Subj & "&body=" & msg ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus Application.Wait (Now + TimeValue("0:00:08")) Application.SendKeys "%s" End Sub Sub Mail_ActiveSheet() Dim strdate As String Dim FName1, FName2, Fullname FName1 = Range("AU2").Value & "-" FName2 = Range("J4").Value Fullname = FName1 & FName2 ActiveSheet.Copy strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss") ActiveSheet.SaveAs "Sheet1 " & Fullname _ & " " & strdate & ".xls" ActiveWorkbook.SendMail "data", _ Fullname ActiveWorkbook.ChangeFileAccess xlReadOnly Kill ActiveWorkbook.Fullname ActiveWorkbook.Close False End Sub |
Repost
Another option.
http://www.paulsadowski.com/WSH/cdo.htm -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Tim" wrote: | Sorry, I posted this yesterday but didn't get a response. I was hoping to try | again today. | | I'm having a problem trying to figure out why one email function works but | another one doesn't. Both codes work on my home computer using Outlook, but | when I try to run them at work(we use Lotus Notes) the Sub | Mail_Text_in_Body_3() code does not create the message. It seems like it is | calling up Lotus Notes but the email message doesn't get created. I have | changed the mail server to Lotus Notes in Internet Explorer. | The code Mail_ActiveSheet() works fine | | | 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 | __________________________________________________ ___________________ | Sub Mail_Text_in_Body_3() | 'Creates statement for a person and emails it to data entry | Dim msg As String, URL As String | Dim Recipient As String, Subj As String | Dim cell As Range | Recipient = "data" | | Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & " | for Incident " & Sheets("Employee List").Range("N7").Value | | msg = "Statement of " & Sheets("Employee List").Range("Q1").Value & " of | My Work" & vbNewLine & vbNewLine | For Each cell In Sheets("Employee List").Range("N3") | msg = msg & vbNewLine & cell | Next cell | msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") | | msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") | URL = "mailto:" & Recipient & "&subject=" & Subj & "&body=" & msg | ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, | vbNormalFocus | Application.Wait (Now + TimeValue("0:00:08")) | Application.SendKeys "%s" | End Sub | | | | | Sub Mail_ActiveSheet() | Dim strdate As String | Dim FName1, FName2, Fullname | FName1 = Range("AU2").Value & "-" | FName2 = Range("J4").Value | Fullname = FName1 & FName2 | ActiveSheet.Copy | strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss") | ActiveSheet.SaveAs "Sheet1 " & Fullname _ | & " " & strdate & ".xls" | ActiveWorkbook.SendMail "data", _ | Fullname | ActiveWorkbook.ChangeFileAccess xlReadOnly | Kill ActiveWorkbook.Fullname | ActiveWorkbook.Close False | End Sub | | |
Repost
More Excel examples for CDO are here
http://www.rondebruin.nl/cdo.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Dave Patrick" wrote in message ... Another option. http://www.paulsadowski.com/WSH/cdo.htm -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Tim" wrote: | Sorry, I posted this yesterday but didn't get a response. I was hoping to try | again today. | | I'm having a problem trying to figure out why one email function works but | another one doesn't. Both codes work on my home computer using Outlook, but | when I try to run them at work(we use Lotus Notes) the Sub | Mail_Text_in_Body_3() code does not create the message. It seems like it is | calling up Lotus Notes but the email message doesn't get created. I have | changed the mail server to Lotus Notes in Internet Explorer. | The code Mail_ActiveSheet() works fine | | | 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 | __________________________________________________ ___________________ | Sub Mail_Text_in_Body_3() | 'Creates statement for a person and emails it to data entry | Dim msg As String, URL As String | Dim Recipient As String, Subj As String | Dim cell As Range | Recipient = "data" | | Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & " | for Incident " & Sheets("Employee List").Range("N7").Value | | msg = "Statement of " & Sheets("Employee List").Range("Q1").Value & " of | My Work" & vbNewLine & vbNewLine | For Each cell In Sheets("Employee List").Range("N3") | msg = msg & vbNewLine & cell | Next cell | msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") | | msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") | URL = "mailto:" & Recipient & "&subject=" & Subj & "&body=" & msg | ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, | vbNormalFocus | Application.Wait (Now + TimeValue("0:00:08")) | Application.SendKeys "%s" | End Sub | | | | | Sub Mail_ActiveSheet() | Dim strdate As String | Dim FName1, FName2, Fullname | FName1 = Range("AU2").Value & "-" | FName2 = Range("J4").Value | Fullname = FName1 & FName2 | ActiveSheet.Copy | strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss") | ActiveSheet.SaveAs "Sheet1 " & Fullname _ | & " " & strdate & ".xls" | ActiveWorkbook.SendMail "data", _ | Fullname | ActiveWorkbook.ChangeFileAccess xlReadOnly | Kill ActiveWorkbook.Fullname | ActiveWorkbook.Close False | End Sub | | |
Repost
Nice. Thank you Ron
-- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
I think I tracked down the problem, too many characters. If I change "N8" to
a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
Hi Tim
http://www.rondebruin.nl/mail/oebody.htm you can read about the limit on this page Do you only use Outlook Express ? -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... I think I tracked down the problem, too many characters. If I change "N8" to a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
We use Lotus Notes at work.
"Ron de Bruin" wrote: Hi Tim http://www.rondebruin.nl/mail/oebody.htm you can read about the limit on this page Do you only use Outlook Express ? -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... I think I tracked down the problem, too many characters. If I change "N8" to a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
We use Lotus Notes at work.
That's not good<g Have you try CDO -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... We use Lotus Notes at work. "Ron de Bruin" wrote: Hi Tim http://www.rondebruin.nl/mail/oebody.htm you can read about the limit on this page Do you only use Outlook Express ? -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... I think I tracked down the problem, too many characters. If I change "N8" to a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
No I haven't. This what I am running. It works as long as cell N10 is less
than 120 characters. 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 Sub Mail_Text_in_Body_3() 'Example for Outlook Express with API call 'In Excel 2002 I can use around 1800 characters Dim msg As String, URL As String Dim Recipient As String, Subj As String Dim Recipientcc As String, Recipientbcc As String Dim cell As Range Recipient = " Recipientcc = "" Recipientbcc = "" 'You can use a cell value also like this 'Recipient = Sheets("mysheet").Range("A1").Value Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & " for Incident " & Sheets("Employee List").Range("N7").Value 'Subj = Sheets("mysheet").Range("A2").Value msg = "Statement for " & Sheets("Employee List").Range("Q1").Value For Each cell In Sheets("Employee List").Range("N10") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") 'If you have hard returns in one of your cells you also need this line (Tip from Keepitcool) msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" & Recipientbcc _ & "&subject=" & Subj & "&body=" & msg ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus Application.Wait (Now + TimeValue("0:00:03")) Application.SendKeys "%s" End Sub "Ron de Bruin" wrote: We use Lotus Notes at work. That's not good<g Have you try CDO -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... We use Lotus Notes at work. "Ron de Bruin" wrote: Hi Tim http://www.rondebruin.nl/mail/oebody.htm you can read about the limit on this page Do you only use Outlook Express ? -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... I think I tracked down the problem, too many characters. If I change "N8" to a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
I haven't been able to figure out CDO.
"Ron de Bruin" wrote: We use Lotus Notes at work. That's not good<g Have you try CDO -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... We use Lotus Notes at work. "Ron de Bruin" wrote: Hi Tim http://www.rondebruin.nl/mail/oebody.htm you can read about the limit on this page Do you only use Outlook Express ? -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... I think I tracked down the problem, too many characters. If I change "N8" to a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
Hi Tim
Never test it with so many characters in a cell Excel is not a Word editor<vbg Will look at it this weekend -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... No I haven't. This what I am running. It works as long as cell N10 is less than 120 characters. 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 Sub Mail_Text_in_Body_3() 'Example for Outlook Express with API call 'In Excel 2002 I can use around 1800 characters Dim msg As String, URL As String Dim Recipient As String, Subj As String Dim Recipientcc As String, Recipientbcc As String Dim cell As Range Recipient = " Recipientcc = "" Recipientbcc = "" 'You can use a cell value also like this 'Recipient = Sheets("mysheet").Range("A1").Value Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & " for Incident " & Sheets("Employee List").Range("N7").Value 'Subj = Sheets("mysheet").Range("A2").Value msg = "Statement for " & Sheets("Employee List").Range("Q1").Value For Each cell In Sheets("Employee List").Range("N10") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") 'If you have hard returns in one of your cells you also need this line (Tip from Keepitcool) msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" & Recipientbcc _ & "&subject=" & Subj & "&body=" & msg ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus Application.Wait (Now + TimeValue("0:00:03")) Application.SendKeys "%s" End Sub "Ron de Bruin" wrote: We use Lotus Notes at work. That's not good<g Have you try CDO -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... We use Lotus Notes at work. "Ron de Bruin" wrote: Hi Tim http://www.rondebruin.nl/mail/oebody.htm you can read about the limit on this page Do you only use Outlook Express ? -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... I think I tracked down the problem, too many characters. If I change "N8" to a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
Repost
Thanks Ron. I sent you an email on your site.
"Ron de Bruin" wrote: Hi Tim Never test it with so many characters in a cell Excel is not a Word editor<vbg Will look at it this weekend -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... No I haven't. This what I am running. It works as long as cell N10 is less than 120 characters. 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 Sub Mail_Text_in_Body_3() 'Example for Outlook Express with API call 'In Excel 2002 I can use around 1800 characters Dim msg As String, URL As String Dim Recipient As String, Subj As String Dim Recipientcc As String, Recipientbcc As String Dim cell As Range Recipient = " Recipientcc = "" Recipientbcc = "" 'You can use a cell value also like this 'Recipient = Sheets("mysheet").Range("A1").Value Subj = "Statement for " & Sheets("Employee List").Range("Q1").Value & " for Incident " & Sheets("Employee List").Range("N7").Value 'Subj = Sheets("mysheet").Range("A2").Value msg = "Statement for " & Sheets("Employee List").Range("Q1").Value For Each cell In Sheets("Employee List").Range("N10") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") 'If you have hard returns in one of your cells you also need this line (Tip from Keepitcool) msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") URL = "mailto:" & Recipient & "?cc=" & Recipientcc & "&bcc=" & Recipientbcc _ & "&subject=" & Subj & "&body=" & msg ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus Application.Wait (Now + TimeValue("0:00:03")) Application.SendKeys "%s" End Sub "Ron de Bruin" wrote: We use Lotus Notes at work. That's not good<g Have you try CDO -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... We use Lotus Notes at work. "Ron de Bruin" wrote: Hi Tim http://www.rondebruin.nl/mail/oebody.htm you can read about the limit on this page Do you only use Outlook Express ? -- Regards Ron de Bruin http://www.rondebruin.nl "Tim" wrote in message ... I think I tracked down the problem, too many characters. If I change "N8" to a cell with less characters in it, it will work. Any work around? Thanks Sub Mail_Text_in_Body() Dim msg As String, cell As Range Dim Recipient As String, Subj As String, HLink As String Dim Recipientcc As String, Recipientbcc As String Recipient = " Recipientcc = "" Recipientbcc = "" Subj = "Statement for " & Sheets("Employee List").Range("P2").Value & " for Incident " & Sheets("Employee List").Range("P3").Value msg = "Dear customer" & vbNewLine & vbNewLine For Each cell In Sheets("Employee List").Range("N8") msg = msg & vbNewLine & cell Next cell msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A") msg = WorksheetFunction.Substitute(msg, vbLf, "%0D%0A") HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "body=" & msg ActiveWorkbook.FollowHyperlink (HLink) Application.Wait (Now + TimeValue("0:00:05")) Application.SendKeys "%s" End Sub "Dave Patrick" wrote: Nice. Thank you Ron -- Regards, Dave Patrick ....Please no email replies - reply in newsgroup. Microsoft Certified Professional Microsoft MVP [Windows] http://www.microsoft.com/protect "Ron de Bruin" wrote: | More Excel examples for CDO are here | http://www.rondebruin.nl/cdo.htm | | | -- | Regards Ron de Bruin | http://www.rondebruin.nl |
| All times are GMT +1. The time now is 09:21 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com