Как персонифицировать описание ошибки вызова метода COM-объекта в скомпилированном приложении? - VB

Формулировка задачи:

Здравствуйте! Пример. Вот такой код:

Private Sub Form_Load()
    On Error GoTo ErrorHandler
    Dim oShell As Object
    Set oShell = CreateObject("WScript.Shell")
    oShell.CurrentDirectory = "***"
    Set oShell = Nothing
    Exit Sub
    
ErrorHandler:
    Debug.Print Now & " - " & "frmMain.Form_Load" & " - #" & Err.Number & " " & Err.Description & ". LastDllError = " & Err.LastDllError
    Resume Next
End Sub

выдаст в IDE ошибку:

"Method 'CurrentDirectory' of object 'IWshShell3' failed."

Если его скомпилировать, получим:

"Method '~' of object '~' failed."

Понимаю, что не находит описания. Попытался установить в References ссылку на WScript.Shell (Windows Script Host Object (syswow64\wshom.ocx), переписав все так:

Private Sub Form_Load()
    On Error GoTo ErrorHandler
    
    Dim oShell As New WshShell
    oShell.CurrentDirectory = "***"
    Exit Sub
    
ErrorHandler:
    MsgBox Now & " - " & "frmMain.Form_Load" & " - #" & Err.Number & " " & Err.Description & ". LastDllError = " & Err.LastDllError
    Resume Next
End Sub

Но это не решило проблемы. Спасибо за помощь.

Решение задачи: «Как персонифицировать описание ошибки вызова метода COM-объекта в скомпилированном приложении?»

textual
                            Листинг программы 
                        

                            Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long
 
Public Sub Main()
    On Error GoTo ErrorHandler
 
    CreateObject("WScript.Shell").CurrentDirectory = "***"
 
    Exit Sub
ErrorHandler:
    AppendErrorLogFormat Now, Err, "Engine.Main", "Что-то", "еще"
    Resume Next
End Sub
 
Private Function MessageText(lCode As Long) As String
    On Error Resume Next
    Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
    
    Dim sRtrnCode   As String
    Dim lRet        As Long
 
    sRtrnCode = Space$(256)
    lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lCode, ByVal 0&, sRtrnCode, ByVal 256&, ByVal 0&)
    If lRet > 0 Then
        MessageText = Left$(sRtrnCode, lRet)
        MessageText = Replace$(MessageText, vbNewLine, vbNullString)
    End If
End Function
 
Public Sub AppendErrorLogFormat(curTime As Date, ByVal ErrObj As ErrObject, ParamArray CodeModule())
    Dim HRESULT     As String
    Dim Other       As String
    Dim ErrNumber   As Long
    Dim ErrDescr    As String
    Dim ErrLastDll  As Long
    Dim i           As Long
    
    ErrNumber = ErrObj.Number           'сохраняю изначальные свойства
    ErrDescr = ErrObj.Description
    ErrLastDll = ErrObj.LastDllError
    
    On Error Resume Next
    
    For i = 1 To UBound(CodeModule)
        Other = Other & CodeModule(i) & " "
    Next
    HRESULT = MessageText(ErrNumber)
    AppendErrorLog _
        curTime & _
        " - " & CodeModule(0) & _
        " - #" & ErrNumber & " " & _
        IIf(Len(HRESULT), "(" & HRESULT & ")", "") & " " & _
        ErrDescr & _
        ". LastDllError = " & ErrLastDll & _
        IIf(Len(Other), ". " & Other, "")
End Sub
                        