How to send e-mail from VBA regardless of MAPI client 1

[klm2klm2]

Some weeks ago, I asked if anyone knows how to send e-mail using VBA regardless of the MAPI client (Outlook, Outlook Express, etc.). The reply I got give me an error. Does anyone know how to make this work?

The following code:

Dim strAttachmentPath As String
Dim iMsg, arrEmail
Set iMsg = CreateObject("CDO.Message&quot
With iMsg
.To = "kimmedlin@yahoo.com"
.From = "youremail@whereever.com"
.Subject = "Subject line"
.TextBody = "See attached docs for more info."
.AddAttachment strAttachmentPath
.send
End With

Gave me the following error:

Run-time error '-2147220960 (80040220)':
The "SendUsing" configuration value is invalid.

The .send line of code was highlighted.

Any ideas anyone?

 

[ajdesalvo]

You can use the Winsock.dll Activex control to send email.

For example:

Create a form and place the Winsock control on the form. Call it Winsock1.

Create a Command Button, and in the On Click Event paste the following code

Call STMPSend("Your Domain", "emailserver name", "adesalvo@scotttechllc.com", "adesalvo@scotttechllc.com", "Test", "This is a test&quot

Paste the following code into the form's module:

Sub STMPSend(strMyDomain As String, _
strEmailServer As String, _
strEmailAddressWithoutDomain As String, _
strWhoToSayThisIsFrom As String, _
strSubject As String, _
strMessageBody As String)
Winsock1.Close
Winsock1.RemoteHost = strEmailServer
Winsock1.RemotePort = 25
Winsock1.Connect
WaitForIt
Select Case left$(strWSIn, 3)
Case "220"
' connected ok, send HELLO
Winsock1.SendData "HELO " & _
strMyDomain & _
vbCrLf
WaitForIt
Winsock1.SendData "MAIL FROM: " & _
strWhoToSayThisIsFrom & _
vbCrLf
WaitForIt
Winsock1.SendData "RCPT TO: " & _
strWhoToSayThisIsFrom & _
vbCrLf
WaitForIt
Winsock1.SendData "DATA" & vbCrLf & _
"DATE:" & _
Format$(Now(), "mm/dd/yyyy hh:mm:ss&quot & _
"FROM: " & _
strWhoToSayThisIsFrom & vbCrLf & _
"TO:" & _
Format$(Now(), "mm/dd/yyyy hh:mm:ss&quot & _
"DATE:" & _
Format$(Now(), "mm/dd/yyyy hh:mm:ss&quot & _
"SUBJECT: " & _
strSubject & _
vbCrLf & _
strMessageBody & _
vbCrLf & _
"." & vbCrLf
' note: . & vbcrlf terminates the "send"
WaitForIt
' parse and validate the return from the sever
End Select
' tell the server you're done:
Winsock1.SendData "QUIT" & vbCrLf
WaitForIt
' and that's it!
Winsock1.Close
MsgBox "Email has been sent!"
End Sub

Private Sub WaitForIt()
WaitingForData = True
While WaitingForData = True
Winsock1.Requery
DoEvents
Wend
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Temp As String
Temp = String(bytesTotal, " &quot
Winsock1.GetData Temp, vbString
Do
If right$(Temp, 1) = vbLf Then
Temp = left$(Temp, Len(Temp) - 1)
End If
Loop While right$(Temp, 1) = vbLf
strWSIn = Temp
WaitingForData = False
End Sub
Anthony J. DeSalvo
President - ScottTech Software
"Integrating Technology with Business"

 

[brianelson]

There is one way to make that CDO code work you have to have a reference for the CDO dll set. Plus there is a microsoft article on this at msdn.microsoft.com about some fix. I do not remember what the article said.Sorry. The following code works great for me from excel 2000

Const cdoSendUsingPort = 2

Set imsg = CreateObject("CDO.Message&quot
Set iConf = CreateObject("CDO.Configuration&quot

Set Flds = iConf.Fields

' Set the CDOSYS configuration fields to use port 25 on the SMTP server.

With Flds
.Item("

http://schemas.microsoft.com/cdo/configuration/sendusing")

= cdoSendUsingPort
'ToDo: Enter name or IP address of remote SMTP server.
.Item("

http://schemas.microsoft.com/cdo/configuration/smtpserver")

= "smtp-out.SERVER.com"
.Item("

http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout")

= 10
.Update
End With

' Build HTML for message body.



' Apply the settings to the message.
With imsg
Set .Configuration = iConf
.To = who & who2 'Enter a valid email address.
.From = "NAME" 'Enter a valid email address.
.Subject = " "
.HTMLBody = strhtml
.Send
End With

 

[klm2klm2]

The code in my original message showed the requirement for an attachment to the e-mail. How can the two suggested solutions support an e-mail attachment?

 

[ajdesalvo]

In me original code, Dim another variable called AttachStr;

Dim AttachStr

Add the function below to a module, this will create binary string of the file to be attached. This is then appended to the body of the message and is sent with the email.

Public Function UUEncodeFile(strFilePath As String) As String

Dim intFile As Integer 'file handler
Dim intTempFile As Integer 'temp file
Dim lFileSize As Long 'size of the file
Dim strFilename As String 'name of the file
Dim strFileData As String 'file data chunk
Dim lEncodedLines As Long 'number of encoded lines
Dim strTempLine As String 'temporary string
Dim i As Long 'loop counter
Dim j As Integer 'loop counter

Dim strResult As String
'
'Get file name
strFilename = Mid$(strFilePath, InStrRev(strFilePath, "\&quot + 1)
'
'Insert first marker: "begin 664 ..."
strResult = "begin 664 " + strFilename + vbCrLf
'
'Get file size
lFileSize = FileLen(strFilePath)
lEncodedLines = lFileSize \ 45 + 1
'
'Prepare buffer to retrieve data from
'the file by 45 symbols chunks
strFileData = Space(45)
'
intFile = FreeFile
'
Open strFilePath For Binary As intFile
For i = 1 To lEncodedLines
'Read file data by 45-bytes cnunks
'
If i = lEncodedLines Then
'Last line of encoded data often is not
'equal to 45, therefore we need to change
'size of the buffer
strFileData = Space(lFileSize Mod 45)
End If
'Retrieve data chunk from file to the buffer
Get intFile, , strFileData
'Add first symbol to encoded string that informs
'about quantity of symbols in encoded string.
'More often "M" symbol is used.
strTempLine = Chr(Len(strFileData) + 32)
'
If i = lEncodedLines And (Len(strFileData) Mod 3) Then
'If the last line is processed and length of
'source data is not a number divisible by 3, add one or two
'blankspace symbols
strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
End If

For j = 1 To Len(strFileData) Step 3
'Breake each 3 (8-bits) bytes to 4 (6-bits) bytes
'
'1 byte
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
'2 byte
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
'3 byte
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
'4 byte
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
Next j
'replace " " with "`"
strTempLine = Replace(strTempLine, " ", "`&quot
'add encoded line to result buffer
strResult = strResult + strTempLine + vbCrLf
'reset line buffer
strTempLine = ""
Next i
Close intFile

'add the end marker
strResult = strResult & "`" & vbCrLf + "end" + vbCrLf
'asign return value
UUEncodeFile = strResult

End Function

Then in my original code replace:

vbCrLf & _
strMessageBody & _
vbCrLf & _
"." & vbCrLf
' note: . & vbcrlf terminates the "send"

with:

vbCrLf & _
strMessageBody & _
vbCrLf & AttachStr & _
"." & vbCrLf
' note: . & vbcrlf terminates the "send"

Good luck!!!

Anthony J. DeSalvo
President - ScottTech Software
"Integrating Technology with Business"