Monday, May 28, 2018

Get an error messsage from Err.LastDllError using FormatMessage in VBA

This is how you can retrieve a message string from a Windows api error code.
Private Declare PtrSafe Function FormatMessage Lib "Kernel32.dll" Alias "FormatMessageW" ( _
    ByVal dwFlags As Long, _
    ByVal lpSource As LongPtr, _
    ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, _
    ByVal lpBuffer As LongPtr, _
    ByVal nSize As Long, _
    ByVal Arguments As LongPtr) As Long
     
Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" ( _
    ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Long)
Private Declare PtrSafe Function SysAllocString Lib "OleAut32.dll" (ByVal psz As LongPtr) As LongPtr
Private Declare PtrSafe Function LocalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr

Function GetApiErrorText(ByVal Code As Long) As String
    Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100&
    Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
    Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200&
 
    'calculated value of MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT)
    Const MAKELANGID_LANG_NEUTRAL_SUBLANG_DEFAULT As Long = &H400
    Dim lpMsgBuf As LongPtr
    
    
    FormatMessage _
        FORMAT_MESSAGE_ALLOCATE_BUFFER Or _
        FORMAT_MESSAGE_FROM_SYSTEM Or _
        FORMAT_MESSAGE_IGNORE_INSERTS, _
        0, _
        Code, _
        MAKELANGID_LANG_NEUTRAL_SUBLANG_DEFAULT, _
        VarPtr(lpMsgBuf), _
        0, _
        0
                  
    Dim lpNewString As LongPtr
    GetApiErrorText = vbNullString
    lpNewString = SysAllocString(lpMsgBuf)
    LocalFree lpMsgBuf
    RtlMoveMemory VarPtr(GetApiErrorText), VarPtr(lpNewString), LenB(lpNewString)
   
End Function

Sub Sample()
    'I put numeric number 1 , instead of Err.LastDllError
    Debug.Print GetApiErrorText(1)
End Sub

Saturday, May 26, 2018

MAKELANGID in VBA

I wonder how I can translate 'MAKELANGID' declared in winnt.h into VBA.
MAKELANGID is declared as follows in winnt.h.
#define MAKELANGID(p, s) ((((WORD )(s)) << 10) | (WORD )(p))

Here's the answer.
-----------------------------------------

Function MAKELANGID(p As Integer, s As Integer) As Integer
    Dim lngTemp As Long
    lngTemp = (ShortToLong(s) * 1024) And &HFFFF&
    MAKELANGID = (lngTemp + ShortToLong(p)) And &HFFFF&
End Function

Function ShortToLong(ByVal Short As Integer) As Long
    ShortToLong = Short And &HFFFF&
End Function