ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Email from excel.. please help?? (https://www.excelbanter.com/excel-discussion-misc-queries/118407-email-excel-please-help.html)

SAM SEBAIHI

Email from excel.. please help??
 

Sending email is working greeat, Kudo to Ron De Bruin. However, I could not change the code to
make Excel to open newsgroup instead of email and send messages to a
newsgroup. I have 20 students that I would like to send messages to their
Individule Newsgroup but I could not do it. This is the code that I have and
modified a little to fit my needs. But I can not have the macro to open a
newsgroup instead of email. Please help.

Thank you all in advance.


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 SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double

For r = 2 To 2 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)

' Message subject
Subj = Cells(r, 1)

' Compose the message
Msg = Cells(r, 3)

' Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

' Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf,
"%0D%0A")

' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus

' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:01"))
' Application.SendKeys "%s"
Next r
End Sub



--------------------------------------------------------------------------------

Sam Sebaihi
Faculty
Western International University
Associate Programs

(alternate email)
Phone #: (405)315-8223 Time zone: Pacific Time


All times are GMT +1. The time now is 08:33 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com