Pour le problème spécifique mentionné dans le PO, il existe une meilleure solution. 'enregistrer' le courrier à Outlook. Ne l'envoyez pas. Il donne à l'utilisateur un contrôle explicite sur ce qui est envoyé, et quand, et ne génère pas de boîtes de dialogue pop-up. Une triple victoire.
Mais puisque vous me demandez ....
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
Ce code est TCP, pas de code de messagerie. Il comprend également le code TCP OSX VBA, que je n'ai pas publié auparavant.
Oui, nous pourrions finir par n'avoir d'autre choix que d'aller avec ce type de solution. Cela me frustre juste que je ne peux pas trouver une réponse simple pour savoir comment faire une connexion TCP n'importe où. Avec VB6, je pourrais juste jeter dans un contrôle de Winsock et être en marche. SMTP est un tel protocole simpliste qu'il serait trivial pour moi de réécrire notre code pour se connecter à notre propre serveur de messagerie manuellement. Il semble juste idiot que je ne peux pas trouver une solution rapide ici. –
Je ne peux vraiment pas imaginer toutes les frustrations qui pourraient aller avec l'utilisation de VBA après VB! C'est comme si vous étiez un kayakiste essayant d'utiliser un canot; et vous me demandez, qui n'a d'expérience dans un canoë, que s'il est vraiment impossible de faire un "rouleau esquimau" complet en canoë. "Oui, ça l'est." Mais je remercie Dieu pour les canoës ... et VBA. – Smandoli
Terrible solution, car vous ne pouvez pas être sûr que vous appropriez le bon dialogue. –