Tuesday, September 11, 2007

Re: Socket Programming in VBA

Re: Socket Programming in VBA
Quote:
Originally Posted by 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. 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.


Code: ( text )
  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
  24. Dim iCfg As CDO.Configuration
  25. Dim iMsg As CDO.Message
  26. Dim mailserver As String
  27. mailserver = DLookup("[SMTPServerName]", "Usys_tblConfigLocal")
  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
  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 <> ""
  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
  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
  86. SendCDOMail = True
  87. Set iMsg = Nothing
  88. Set iCfg = Nothing
  89. PleaseWait ("")
  90. Exit_SendCDOMail:
  91. Exit Function
  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
  101. End Function



Regards

Jim

posted by BillyIdiot(gethoper) @ 10:55 AM

0 Comments:

Post a Comment

<< Home