如何从 Microsoft Access 与 Visual Basic 建立网络连接？

Question

我们在 Microsoft Access 中有一个 Visual Basic 应用程序，我们需要建立网络连接。 对于 VB6，有一个名为 WinSock 的方便的小控件使这成为可能，但我找不到 Microsoft Access 内部存在的精简 VB 版本的任何类似内容。 有任何想法吗？

由于我没有得到任何答案，我将尽力澄清我需要这个的目的。

我的应用程序发送一封电子邮件，我们当前正在使用内置 Outlook 对象来创建消息并在后台发送。 缺点是它会提示用户批准“外部程序”发送电子邮件，这让我们的用户感到沮丧，而且似乎没有必要。 我在网上找到的所有其他电子邮件选项都要求我们下载或购买控件，这对于我们部署给所有用户来说过于劳力密集。

我希望使用套接字控件手动连接到 SMTP 服务器并发送消息（因为这在其他语言中很简单），但我找不到任何方法在 VBA 中建立 TCP 连接。

Answer 1

我上个月刚刚处理过这个问题。 由于种种原因，CDO还不够充分，直接使用MAPI的方式过于复杂，而且你所抱怨的Outlook提示完全无法接受。

我最终使用了 Outlook 兑换。 它被 Access 开发人员广泛使用，尽管我发现它相当复杂并且没有很好的文档记录。 但它做得很好。

Answer 2

微软添加的电子邮件“安全”功能让很多开发者感到沮丧。 我不知道有什么优雅的解决方案。 我已经成功地使用了免费软件应用程序 ClickYes Express，但这当然不是您寻求的答案。

Answer 3

对于OP中提到的具体问题，有更好的解决方案。 将邮件“保存”到 Outlook。 不要“发送”它。 它使用户可以明确控制发送内容和发送时间，并且不会生成弹出对话框。 三赢。

但既然你问了……

Option Explicit

Public Const AF_INET = 2 'internetwork: UDP, TCP, etc.
Public Const SOCK_STREAM = 1 'Stream socket
Public Const SOCKET_ERROR = -1

Type sockaddr_in
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

#If Win32 Then

'for WSAStartup() function.
Public Const WSADESCRIPTION_LEN = 256
Public Const WSASYS_STATUS_LEN = 128
Public Const WSA_DescriptionSize = WSADESCRIPTION_LEN + 1
Public Const WSA_SysStatusSize = WSASYS_STATUS_LEN + 1

Type wsaData
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSA_DescriptionSize
    szSystemStatus As String * WSA_SysStatusSize
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As String * 200
End Type

#If Not VBA7 Then
'Use this section for Excel 95
Type Hostent
    h_name As Long          '32 bit pointer
    h_aliases As Long       '32 bit pointer
    h_addrtype As Integer   'String * 2 (declared as short)
    h_length As Integer     'String * 2 (declared as short)
    h_addr_list As Long     '32 bit pointer
End Type

Public Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Public Declare Function connect Lib "ws2_32.dll" (ByVal sID As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
Public Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Public Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Public Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function recvstr Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal Protocol As Long) As Long
Public Declare Function WSAStartup Lib "ws2_32.dll" (wVersionRequested As Integer, lpWSAData As wsaData) As Long
Public Declare Function WSACleanup Lib "ws2_32.dll" () As Long

'Public Declare Function setsockopt Lib "ws2_32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public Declare Function gethostbyname Lib "ws2_32.dll" (ByVal host_name As String) As Long

#Else
'on Win64, ws2_32.dll in system32 has the file description "32-bit DLL" and uses 64bit pointers (morons)
'on Win64 as on Win32, 32-bit numbers are called int.
'on VBA7/64, as on VBA6/32, 32 bit numbers are called long.
'delete following duplicate section for Excel 95

Type Hostent
    h_name As LongPtr       '32/64 bit pointer
    h_aliases As LongPtr    '32/64 bit pointer
    h_addrtype As Integer   'String * 2 (declared as short)
    h_length As Integer     'String * 2 (declared as short)
    h_addr_list As LongPtr  '32/64 bit pointer
End Type


Public Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal sID As LongPtr) As Long
Public Declare PtrSafe Function connect Lib "ws2_32.dll" (ByVal sID As LongPtr, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
Public Declare PtrSafe Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Public Declare PtrSafe Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Public Declare PtrSafe Function recv Lib "ws2_32.dll" (ByVal sID As LongPtr, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function recvstr Lib "ws2_32.dll" (ByVal sID As LongPtr, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal sID As LongPtr, ByRef buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare PtrSafe Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal Protocol As Long) As Long
Public Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (wVersionRequested As Integer, lpWSAData As wsaData) As Long
Public Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long

'Public Declare PtrSafe Function setsockopt Lib "ws2_32.dll" (ByVal sID As Long, ByVal level As LongPtr, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Public Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As LongPtr)
Public Declare PtrSafe Function gethostbyname Lib "ws2_32.dll" (ByVal host_name As String) As LongPtr


#End If
#Else
'OSX
'delete following duplicate section for Excel 95
'No 64bit version of Excel is available yet for the OSX
Type Hostent
    h_name As Long      '32 bit pointer
    h_aliases As Long   '32 bit pointer
    h_addrtype As Long  '32 bit int (declared as int)
    h_length As Long    '32 bit int (declared as int)
    h_addr_list As Long '32 bit pointer
End Type

'ssize_t is a signed type. signed version of size_t,
'used where a size may instead contain a negative error code
'size_t is the unsigned integer type of the result of the sizeof operator
'size_t is an unsigned integer type of at least 16 bit

'or libsystem.dylib ?
Public Declare Function socket Lib "libc.dylib" (ByVal af As Long, ByVal s_type As Long, ByVal Protocol As Long) As Long
Public Declare Function connect Lib "libc.dylib" (ByVal s As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
' or read ?
Public Declare Function recv Lib "libc.dylib" (ByVal s As Long, buf As   Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function send Lib "libc.dylib" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Public Declare Function htons Lib "libc.dylib" (ByVal Host_Short As Integer) As Integer 'x x x, but seems to work !!!
Public Declare Function inet_addr Lib "libc.dylib" (ByVal cp As String) As Long
Public Declare Function closesocket Lib "libc.dylib" Alias "close" (ByVal s As Long) As Long
Public Declare Function setsockopt Lib "libc.dylib" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Public Declare Function gethostbyname Lib "libc.dylib" (ByVal host_name As String) As Long
Public Declare Sub CopyMemory Lib "libc.dylib" Alias "memmove" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

#End If

Private Function MyData(I_SocketAddress As sockaddr_in, Register As Integer, dataword As Long, serr As String) As Long
Dim strSend     As String
Dim count       As Integer
Dim bArray()    As Byte
Dim errCode     As Integer
Dim socketID    As Long

socketID = socket(AF_INET, SOCK_STREAM, 0)
errCode = connect(socketID, I_SocketAddress, Len(I_SocketAddress))

count = send(socketID, ByVal strSend, Len(strSend), 0)

If count <> Len(strSend) Then
    errCode = -1
    serr = "ERROR: network failure on send, " & Err.LastDllError()
Else
    count = RecvB(socketID, bArray, maxLength)

    dodata bArray
End If
    DoEvents
    Call closesocket(socketID)
    MyData = errCode
End Function

Private Function RecvB(socketID As Long, bArray() As Byte, ByVal maxLength As Integer) As Integer
Dim c As String * 1
Dim b           As Byte
Dim buf()       As Byte
Dim Length      As Integer
Dim count       As Long
Dim i           As Integer
Dim dStartTime  As Variant
Dim nErr        As Long

Const iFlags = 0

ReDim bArray(1 To maxLength)
ReDim buf(1 To maxLength)

dStartTime = Time
While (Length < maxLength) And (4 > DateDiff("s", dStartTime, Time))
    DoEvents
    count = recv(socketID, buf(1), maxLength, iFlags)

    If count = SOCKET_ERROR Then '-1
        nErr = Err.LastDllError()
        If nErr = 0 Then
            RecvB = -1
        Else
            RecvB = -nErr
        End If
        'Debug.Print "socket_error in RecvB. lastdllerror:", nErr
        Exit Function '
    End If '
    For i = 1 To count
        bArray(Length + i) = buf(i)
    Next
    Length = Length + count
Wend
RecvB = Length

End Function

这是 TCP 代码，而不是电子邮件代码。 它还包括 OSX VBA TCP 代码，我之前没有发布过。