Socket Programming in VBA

[Stwange]

Can anyone point me in the right direction here?
As part of a database I'm designing, it has to be able to connect to an SMTP server. I know how to go about the protocol once connected, I know the hostname and port, I just don't know how to connect in the first place.

All I need to know is:
1. What object type allows me to make this connection? And what references do I need to be able to do this?
2. How do I open a connection, send to the server, read from the server, and close?

Thank-you in advance.

[Jim Doherty]

Can anyone point me in the right direction here?
As part of a database I'm designing, it has to be able to connect to an SMTP server. I know how to go about the protocol once connected, I know the hostname and port, I just don't know how to connect in the first place. In addition I store the name of the SMTP server in a one line configtable in the frontend database in case the smtp servername changes and I don't want to revisit my code meely for this

All I need to know is:
1. What object type allows me to make this connection? And what references do I need to be able to do this?
2. How do I open a connection, send to the server, read from the server, and close?

Thank-you in advance.

Set a reference to Microsoft CDO for Windows 2000 Library


Here is a fully tested Function that I use for one of my production systems where parameters are passed in which includes a concatenated list of file attachments from a pop up dialog Access form resembling the usual outlook form. The form itself uses the usual automation techniques in order to retrieve outlook folders,users email addresses etc but which DOESNT use outlook to send the mail message instead favouring simple SMTP direct server access for sending the message but with a 'copy' returning back into outlook (their standard mail client for proof of sending... they didnt want to get into trying to byepass the security SP2 annoying popup message and didnt want to use ClickYes PRO small third party app either :)

Just remove the lines where I am calling in the function PLEASEWAIT This is merely a floating pop I use to relay information to the user as to the status of action in the send process so that they know whats going on (you might want to keep something like that in yours? thats why I left the lines in... whatever.) I don't know whether you have your own method for that but if you want the function let me know.

I also lookup the string value of the SMTP server name from a one line config table in case the server name changes in future and I don't want to revisit my code just for that. The value of which is editable from the usual dialog setup screens I tend to supply for variable system config stuff.

Public Function SendCDOMail(ByVal strFrom As String, ByVal strTo As String, intPerID, ByVal strSubject As String, ByVal strBody As String, strAttachmentPath As String) As Boolean
On Error GoTo Err_SendCDOMail
   If Trim$(strFrom) = "" Then
        MsgBox "No email for the sender portion has been specified", vbExclamation, "Send Mail"
        SendCDOMail = False
        Exit Function
    End If
    If Trim$(strTo) = "" Then
        MsgBox "No recipient email address has been specified", vbExclamation, "Send Mail"
        SendCDOMail = False
        Exit Function
    End If
   If Trim$(strSubject) = "" Then
        MsgBox "No subject heading for the email was retrieved!", vbExclamation, "Send Mail"
        SendCDOMail = False
        Exit Function
    End If
   If Trim$(strBody) = "" Then
        MsgBox "No text body for the email was retrieved!", vbExclamation, "Send Mail"
        SendCDOMail = False
        Exit Function
    End If

Dim iCfg As CDO.Configuration
Dim iMsg As CDO.Message
Dim mailserver As String
mailserver = DLookup("[SMTPServerName]", "Usys_tblConfigLocal")

Set iCfg = New CDO.Configuration
PleaseWait ("Setting up email connection using C.D.O protocol...")
With iCfg
.Fields(cdoSMTPServer) = mailserver
.Fields(cdoSMTPServerPort) = 25 ' typically
.Fields(cdoSendUsingMethod) = cdoSendUsingPort
.Fields(cdoSMTPConnectionTimeout) = 200
.Fields.Update
End With

Set iMsg = New CDO.Message
With iMsg
Set .Configuration = iCfg
.From = ""
.Sender = strFrom
.ReplyTo = strFrom
.Subject = strSubject
.TextBody = strBody
.To = strTo
.CC = strFrom
If strAttachmentPath <> "" Then
    PleaseWait ("Gathering file attachments...")
                        Dim Count As Integer, f() As String, i As Integer, FileName As String, myfiles As String
                        Erase f
                        FileName = Dir(strAttachmentPath, vbNormal + vbHidden + vbSystem)    ' Get first file name.
                        'objEmail.Attachments.Add FileName
                        'Iterate through PATH, caching all files in F()
                        Do While FileName <> ""
                
                            If FileName <> "." And FileName <> ".." Then
                                If (GetAttr(strAttachmentPath + FileName) And vbDirectory) <> vbDirectory Then
                                    If err <> 53 And err <> 76 Then
                                        If (Count Mod 10) = 0 Then
                                            ReDim Preserve f(Count + 10)    ' Resize the array.
                                        End If
                                        Count = Count + 1    ' Increment counter.
                                        f(Count) = FileName
                                        PleaseWait ("Retrieving filenames..." & FileName)
                                    End If
                                End If
                            End If
                
                
                            .AddAttachment strAttachmentPath + FileName
                            FileName = Dir    ' Get another file name.
                        Loop
End If
PleaseWait ("Sending " & strSubject & " email please be patient. I am communicating with the server. You will be informed of the result...")
.Send
End With
    msg = "Message Sent!" & vbCrLf & vbCrLf
    msg = msg & "A copy of this email has been sent (CC'd)" & vbCrlf
    msg = msg & "to your email inbox as proof of sending"
    MsgBox msg, vbInformation, "Application Name Email Message"
On Error Resume Next
   

SendCDOMail = True
Set iMsg = Nothing
Set iCfg = Nothing
PleaseWait ("")
Exit_SendCDOMail:
    Exit Function

Err_SendCDOMail:
PleaseWait ("")
Set iMsg = Nothing
Set iCfg = Nothing
SendCDOMail = False
    MsgBox err.Description, vbInformation, "SendCDOMail Function error Command Cancelled"
    Resume Exit_SendCDOMail

End Function

Regards

Jim

[Stwange]

That's brilliant mate, and a lot more than I expected!

Thank-you.

[Scott Price]

Ignore me, just subscribing :-)

Regards,
Scott

[Jim Doherty]

That's brilliant mate, and a lot more than I expected!

Thank-you.

You're welcome

Jim