I have this problem getting email to work.
The VBA program given just does not cut it in various ways:
** QUOTE **
#If VBA7 And Win64 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll"
Alias "ShellExecuteA" ( _
ByVal hwnd As LongPtr, ByVal lpOperation As
String, _
ByVal lpFile As String, ByVal lpParameters As
String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
#Else
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
#End If
Sub SendEMail()
'update by Extendoffice 20160506
Dim xEmail As String
Dim xSubj As String
Dim xMsg As String
Dim xURL As String
Dim i As Integer
Dim k As Double
Dim xCell As Range
Dim xRg As Range
Dim xTxt As String
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select the data range:",
"Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
If xRg.Columns.Count <> 3 Then
MsgBox " Regional format error, please check", , "Kutools for
Excel"
Exit Sub
End If
For i = 1 To xRg.Rows.Count
' Get the email address
xEmail = xRg.Cells(i, 2)
' Message subject
xSubj = "Your Registration Code"
' Compose the message
xMsg = ""
xMsg = xMsg & "Dear " & xRg.Cells(i, 1) & "," & vbCrLf & vbCrLf
xMsg = xMsg & " This is your Registration Code "
xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf
xMsg = xMsg & " please try it, and glad to get your feedback! "
& vbCrLf
xMsg = xMsg & "Skyyang"
' Replace spaces with %20 (hex)
xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")
xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf,
"%0D%0A")
' Create the URL
xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg
' Execute the URL (start the email client)
ShellExecute 0&, vbNullString, xURL, vbNullString,
vbNullString, vbNormalFocus
' Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
Next
End Sub
** END QUOTE **
Stupidity: one knows the environment, so the #If..#End If is not needed.
Problem: the "Private Declare Function ShellExecute Lib "shell32.dll"
Alias "ShellExecuteA" () produces the error message "Only comments may
appear after End Sub, End Function, or End Property"
So I moved the #If..#End If to after the End Sub; no joy.
Turns out that no matter what one does with this Declare Function
statement, the compiler barfs.
Removing it means the ShellExecute call in the program body cannot
execute (compiler complains the function is not declared).
So the code as-is is useless.
How in the heck can one send an e-mail in Excel VBA?
Thanks.
--
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus