I have a access database with some forms and vba code behind the forms.
On Form_Open (on every form) I have this piece of code.
Dim hWindow As Long
Dim nResult As Long
Dim nCmdShow As Long
hWindow = Application.hWndAccessApp
nCmdShow = SW_HIDE
nResult = ShowWindow(ByVal hWindow, ByVal nCmdShow)
Call ShowWindow(Me.hWnd, SW_NORMAL)
This hides Access and shows only the opened form.
My problem is that Access is starting, but the form will not open.
I have to kill the Access task in task manager.
Is there any way to solve the problem?
EDIT: Every form is a PopUp
As I understand, you need to hide main form and leave popup form open. I normally use window opacity settings instead of hiding:
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const LWA_ALPHA As Long = &H2&
Private Const LWA_COLORKEY As Long = &H1&
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_EX_LAYERED As Long = &H80000
Public Function SetWndOpacity(hwnd As Long, opacity As Byte, clr As Long)
DoCmd.Maximize
SetWindowLong hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes hwnd, 0&, opacity, LWA_ALPHA
End Function
Then call:
SetWndOpacity Access.hWndAccessApp(), 0, 0
Related
I'm trying to position a couple of external windows from within my application but either end up with just a piece of the title bar on screen near the top left or the window goes far to the right and ends up at x = 32767
The function declarations are in a module and the Move_Notepad Sub is part of a form.
Option Explicit On
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function MoveWindow Lib "user32.dll" Alias "MoveWindow" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Sub Move_Notepad()
'Move NotePad to 1,1 and set its Width and height to 800,720 (pixels)
Dim GoWindow As Long
hWinHand = FindWindow(vbNullString, "Untitled - Notepad")
GoWindow = MoveWindow(hWinHand, 1, 1, 800, 720, 1)
End Sub
Private Sub bMove_Notepad_Click(sender As Object, e As EventArgs) Handles bMove_Notepad.Click
Move_Notepad()
End Sub
I installed the PInvoke.net Visual Studio Extension extension and got the following code which finallyworked for me:
<DllImport("user32.dll")>
Public Function MoveWindow(ByVal hWnd As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal bRepaint As Boolean) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Public Function FindWindow(
ByVal lpClassName As String,
ByVal lpWindowName As String) As IntPtr
End Function
I've successfully removed the ribbon on startup by using this line of code:
DoCmd.ShowToolbar "Ribbon", acToolbarNo
But this also removes the Quick Access Toolbar. I want this to stay so that the user can only see the icons I've selected to be shown (Copy, Paste, Export to Excel, etc,.)
My ultimate goal is to have only these icons appear, and the header to be otherwise empty, thin and out of the way. I'm trying to save as much screen space as possible, and I do not want the user to have to ability to expand the ribobn.
Is there a similar line of code that will force the QAT to be shown. Furthermore, is there a way to select which shortcuts will appear in the QAT with VBA. I know this can be done manually, but I'm trying to automate it.
Looks like it's possible using custom Access XML
Start by going and reading through this
https://support.office.com/en-us/article/Customize-the-Ribbon-45e110b9-531c-46ed-ab3a-4e25bc9413de
and then you'll need to create your own bit of XML code to control everything
here a list of the control idMso to use http://www.ribboncreator2010.de/Onlinehelp/EN/_2el0osmon.htm
the following is a something i whipped together as a proof of concept
<?xml version="1.0" encoding="UTF-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="true">
<tabs>
<tab idMso="TabAddIns">
</tab>
</tabs>
<qat>
<documentControls>
<control idMso="SaveObjectAs" />
</documentControls>
</qat>
</ribbon>
</customUI>
this is what is looks like
Not sure how helpful is replying to 5 years old thread, but who knows...
Few days ago I had to (finally) move from Access 2010 to 2021 and was stunned with new UI in general, but mostly with how much space is wasted at the top, especially for my usual scenario for distributed apps - QAT without ribbons and everything else on the right mouse. I didn't take it very seriously at first, believing I'm not the only one with such layout and ready-made solution(s) would be there, in numbers. That was a second surprise, because there are none. "Blank" ribbon is still wasting 40-50px of space with File ribbon not removable. Aside from ruining the concept, everybody will ask "Why is this blank File menu there doing nothing...??"
This is not very difficult to solve, but (like everybody else) I prefer copy/paste to writing own solution from scratch, sadly it was not there to grab :) So here's simple solution for those who want their ~40px back :)
It is assumed you handle all the usual stuff like hiding navigation bar, prevent F11, opening with Shift, hiding Taskbar etc. Or not. It will work even in "design" mode scenarios, but it's not meant for that. For now I simply hardcoded 45px for Window bar/QAT height, can be modified, calculated, but can't be bothered at the moment. Also, this will not work with Access 2010 and earlier, can be made to work if somebody wants to play with it, I'll not
Here's code
Somewhere in your start up routine add these 2 lines of code
moveMDIUp
SubClass_On Access.hWndAccessApp
Create new Code module and insert this code:
'######################################################################
'Module to show only QAT and hide the ribbon
'Miroslav, June 2022
'######################################################################
Option Compare Database
Option Explicit
'Set height of window/QAT bar you wish to keep/see
Private Const QAT_Height = 45
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPtr
Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal wNewWord As LongPtr) As LongPtr
Private Const GWL_WNDPROC = (-4)
Private Const WM_WINDOWPOSCHANGED = &H47
Private Const WM_SYSCOMMAND = &H112
Private m_PrevProc As LongPtr
Private m_PrevProcSH As LongPtr
Private SHDhwnd As LongPtr
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Sub moveMDIUp()
Dim MDIhwnd, ACChwnd, TASKhwnd, NAVhwnd, RIBhwnd, s
Dim navWidth As Long: Dim taskHeight As Long: Dim ribHeight As Long: Dim accWidth As Long: Dim accHeight As Long: Dim mRECT As RECT
ACChwnd = Application.hWndAccessApp
MDIhwnd = FindWindowEx(ACChwnd, 0, "MDIClient", vbNullString)
SHDhwnd = FindWindowEx(ACChwnd, 0, "DropShadow", vbNullString)
'Hide shadow below the ribbon
ShowWindow SHDhwnd, 0
'Get Access width and height
GetWindowRect ACChwnd, mRECT
accHeight = mRECT.Bottom - mRECT.Top
accWidth = mRECT.Right - mRECT.Left
'Find height of taskbar, if not shown it's 0 height
TASKhwnd = FindWindowEx(ACChwnd, 0, "MsoCommandBarDock", "MsoDockBottom")
TASKhwnd = FindWindowEx(TASKhwnd, 0, "MsoCommandBar", "Status Bar")
GetWindowRect TASKhwnd, mRECT
taskHeight = mRECT.Bottom - mRECT.Top
s = SetWindowPos(MDIhwnd, 0, 0, QAT_Height, accWidth - 2, accHeight - QAT_Height - taskHeight - 1, 0)
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(m_PrevProc, hwnd, uMsg, wParam, lParam)
If (uMsg = WM_SYSCOMMAND) And (wParam = 61536) Then
'unhook here...
Call SubClass_Off(Application.hWndAccessApp)
Call SubClassSH_Off(SHDhwnd)
Exit Function
End If
End Function
Public Function SubClass_On(ByVal hwnd As Long)
m_PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
Call SubClassSH_On(SHDhwnd)
End Function
Public Function SubClass_Off(ByVal hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, m_PrevProc
End Function
Public Function WindowProcSH(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProcSH = CallWindowProc(m_PrevProcSH, hwnd, uMsg, wParam, lParam)
If uMsg = WM_WINDOWPOSCHANGED Then
moveMDIUp
End If
End Function
Public Function SubClassSH_On(ByVal hwnd As Long)
m_PrevProcSH = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProcSH)
End Function
Public Function SubClassSH_Off(ByVal hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, m_PrevProcSH
End Function
I am trying to use the function URLDownloadToFile in Access 2010 VBA code. When i run the code it tells me that URLDownloadToFile is not defined.
I have read that this function is in the urlmon.dll which i DO have on my computer. I tried to click the references button in the code editor and load it but it would not let me do so.
How can I fix this so I can use the function? Or is there another function that will allow me to download a url to to a file?
You'll need to declare this WinAPI function in order to call it from procedures in your code.
From HERE
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then
If Dir(LocalFileName) <> vbNullString Then
DownloadFile = True
End If
End If
End Function
Private Sub Form_Load()
If Not DownloadFile("http://www.ex-designz.net", "c:\\photogallery.asp") Then
MsgBox "Unable to download the file, or the source URL doesn't exist."
End If
End Sub
I use this program in winx86 without any error but when i try use it in win x64 my problems started.
I use ptrsafe in my code to let me run in win 7 64bit, I'll add that this module have more code but for limitations of this site i had delete that. if need to now that lines of my code tell me to put them here.
please help me and tell me Why my code produce an error:
'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type
Private MSGHOOK As MSGBOX_HOOK_PARAMS
#If VBA7 Then
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
#Else
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
#End If
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
If uMsg = HCBT_ACTIVATE Then
SetDlgItemText wParam, vbYes, "بلـي"
SetDlgItemText wParam, vbNo, "خـير"
SetDlgItemText wParam, vbIgnore, "انصـراف"
SetDlgItemText wParam, vbOK, "تـــاييد"
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function
Public Function MsgBoxFa(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Tiltle = "", Optional HelpFile, Optional Context) As Long
'Wrapper function for the MessageBox API
Dim hwndThreadOwner As Long
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm
hwndThreadOwner = frmCurrentForm.hwnd
Dim hInstance As Long
Dim hThreadId As Long
Dim hwndOwner As Long
hwndOwner = GetDesktopWindow()
hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
With MSGHOOK
.hwndOwner = hwndOwner
'in next line the error produced******************************
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With
MsgBoxFa = MessageBox(hwndThreadOwner, Prompt, Tiltle, Buttons)
End Function
We have a Visual Basic application inside of Microsoft Access and we need to make a network connection. With VB6, there was a handy little control called WinSock that made this possible, but I can't find anything similar for the stripped down VB version that exists inside of Microsoft Access. Any ideas?
Since I'm not getting any answers, I'll try to clarify what I need this for.
My application sends out an email, and we're currently using a built-in Outlook object to create a message and send it in the background. The drawback is that it prompts the user to approve an "outside program" to send an email, which is frustrating our users and seems unnecessary. All of the other emailing options I've been able to find online require us to either download or purchase a control, which would be too labor intensive for us to deploy to all of our users.
I was hoping to use a socket control to manually connect to the SMTP server and send a message (since this is trivial in other languages) but I can't find any way to make a TCP connection in VBA.
I just dealt with this very issue in the last month. For various reasons, CDO was not adequate, direct use of MAPI way too complex, and the Outlook prompt you complain about completely unacceptable.
I ended up using Outlook Redemption. It's widely used by Access developers, though I found it to be rather convoluted and not terribly well-documented. But it is doing the job quite well.
The email "security" feature added by Microsoft has frustrated many developers. I don't know of an elegant solution. I've used the freeware app ClickYes Express with success, but of course that's not the answer you seek.
For the specific problem mentioned in the OP, there is a better solution. 'save' mail to Outlook. Do not 'send' it. It gives the user explicit control over what is sent, and when, and does not generate pop-up dialogs. A triple win.
But since you ask....
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
This is TCP code, not email code. It's also includes OSX VBA TCP code, which I have not previously published.