By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
445,705 Members | 1,829 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 445,705 IT Pros & Developers. It's quick & easy.

Socket Programming in VBA

Expert 100+
P: 126
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.
Sep 7 '07 #1
Share this Question
Share on Google+
4 Replies


Jim Doherty
Expert 100+
P: 897
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.


Expand|Select|Wrap|Line Numbers
  1. 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
  2. On Error GoTo Err_SendCDOMail
  3.    If Trim$(strFrom) = "" Then
  4.         MsgBox "No email for the sender portion has been specified", vbExclamation, "Send Mail"
  5.         SendCDOMail = False
  6.         Exit Function
  7.     End If
  8.     If Trim$(strTo) = "" Then
  9.         MsgBox "No recipient email address has been specified", vbExclamation, "Send Mail"
  10.         SendCDOMail = False
  11.         Exit Function
  12.     End If
  13.    If Trim$(strSubject) = "" Then
  14.         MsgBox "No subject heading for the email was retrieved!", vbExclamation, "Send Mail"
  15.         SendCDOMail = False
  16.         Exit Function
  17.     End If
  18.    If Trim$(strBody) = "" Then
  19.         MsgBox "No text body for the email was retrieved!", vbExclamation, "Send Mail"
  20.         SendCDOMail = False
  21.         Exit Function
  22.     End If
  23.  
  24. Dim iCfg As CDO.Configuration
  25. Dim iMsg As CDO.Message
  26. Dim mailserver As String
  27. mailserver = DLookup("[SMTPServerName]", "Usys_tblConfigLocal")
  28.  
  29. Set iCfg = New CDO.Configuration
  30. PleaseWait ("Setting up email connection using C.D.O protocol...")
  31. With iCfg
  32. .Fields(cdoSMTPServer) = mailserver
  33. .Fields(cdoSMTPServerPort) = 25 ' typically
  34. .Fields(cdoSendUsingMethod) = cdoSendUsingPort
  35. .Fields(cdoSMTPConnectionTimeout) = 200
  36. .Fields.Update
  37. End With
  38.  
  39. Set iMsg = New CDO.Message
  40. With iMsg
  41. Set .Configuration = iCfg
  42. .From = ""
  43. .Sender = strFrom
  44. .ReplyTo = strFrom
  45. .Subject = strSubject
  46. .TextBody = strBody
  47. .To = strTo
  48. .CC = strFrom
  49. If strAttachmentPath <> "" Then
  50.     PleaseWait ("Gathering file attachments...")
  51.                         Dim Count As Integer, f() As String, i As Integer, FileName As String, myfiles As String
  52.                         Erase f
  53.                         FileName = Dir(strAttachmentPath, vbNormal + vbHidden + vbSystem)    ' Get first file name.
  54.                         'objEmail.Attachments.Add FileName
  55.                         'Iterate through PATH, caching all files in F()
  56.                         Do While FileName <> ""
  57.  
  58.                             If FileName <> "." And FileName <> ".." Then
  59.                                 If (GetAttr(strAttachmentPath + FileName) And vbDirectory) <> vbDirectory Then
  60.                                     If err <> 53 And err <> 76 Then
  61.                                         If (Count Mod 10) = 0 Then
  62.                                             ReDim Preserve f(Count + 10)    ' Resize the array.
  63.                                         End If
  64.                                         Count = Count + 1    ' Increment counter.
  65.                                         f(Count) = FileName
  66.                                         PleaseWait ("Retrieving filenames..." & FileName)
  67.                                     End If
  68.                                 End If
  69.                             End If
  70.  
  71.  
  72.                             .AddAttachment strAttachmentPath + FileName
  73.                             FileName = Dir    ' Get another file name.
  74.                         Loop
  75. End If
  76. PleaseWait ("Sending " & strSubject & " email please be patient. I am communicating with the server. You will be informed of the result...")
  77. .Send
  78. End With
  79.     msg = "Message Sent!" & vbCrLf & vbCrLf
  80.     msg = msg & "A copy of this email has been sent (CC'd)" & vbCrlf
  81.     msg = msg & "to your email inbox as proof of sending"
  82.     MsgBox msg, vbInformation, "Application Name Email Message"
  83. On Error Resume Next
  84.  
  85.  
  86. SendCDOMail = True
  87. Set iMsg = Nothing
  88. Set iCfg = Nothing
  89. PleaseWait ("")
  90. Exit_SendCDOMail:
  91.     Exit Function
  92.  
  93. Err_SendCDOMail:
  94. PleaseWait ("")
  95. Set iMsg = Nothing
  96. Set iCfg = Nothing
  97. SendCDOMail = False
  98.     MsgBox err.Description, vbInformation, "SendCDOMail Function error Command Cancelled"
  99.     Resume Exit_SendCDOMail
  100.  
  101. End Function

Regards

Jim
Sep 7 '07 #2

Expert 100+
P: 126
That's brilliant mate, and a lot more than I expected!

Thank-you.
Sep 7 '07 #3

Scott Price
Expert 100+
P: 1,384
Ignore me, just subscribing :-)

Regards,
Scott
Sep 7 '07 #4

Jim Doherty
Expert 100+
P: 897
That's brilliant mate, and a lot more than I expected!

Thank-you.
You're welcome

Jim
Sep 9 '07 #5

Post your reply

Sign in to post your reply or Sign up for a free account.