Private Const ERROR_INSUFFICIENT_BUFFER As Long = 122
Private Const ERROR_INVALID_FLAGS As Long = 1004&
Private Const ERROR_INVALID_PARAMETER As Long = 87

Public Enum Codepage
'пропушено – ....
End Enum

Private Enum WMFlags
    WC_COMPOSITECHECK = &H200
    WC_DISCARDNS = &H10
    WC_SEPCHARS = &H20
    WC_DEFAULTCHAR = &H40
End Enum

Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal Codepage As Codepage, ByVal Flags As WMFlags, ByVal WideChar As String, ByVal WideCharCount As Long, ByVal Multibyte As String, ByVal MultiByteCount As Long, ByVal DefaultChar As String, ByVal DefaultCharUsed As Long) As Long

Public Function Multibyte(ByRef Codepage As Codepage, ByRef Value As String) As String
    Dim Response As Long
    Dim DefaultCharUsed As Boolean
    Dim Flags As Long
    Response = WideCharToMultiByte(Codepage, 0, Value, -1, Multibyte, 0, 0, 0)
    If Response = 0 Then
        Select Case Err.LastDllError
            Case Is = ERROR_INSUFFICIENT_BUFFER
                Err.Raise 5000, , "Multibyte:" & "Insufficient buffer."
            Case Is = ERROR_INVALID_FLAGS
                Err.Raise 5000, , "Multibyte:" & "Not valid flags."
            Case Is = ERROR_INVALID_PARAMETER
                Err.Raise 5000, , "Multibyte:" & "Not valid parameter."
        End Select
    End If
    Multibyte = String$(Response, 0)
    Flags = WC_SEPCHARS
    Response = WideCharToMultiByte(Codepage, 0, Value, -1, Multibyte, Response, "?", DefaultCharUsed)
End Function

Dim a As String
Dim b As String
Dim fff As New FileSystemObject
Dim f As Files
Dim ph As Folder
Dim q As File

Private Sub Form_Load()
  Set ph = fff.GetFolder("C:\LantY\New Folder") 'папка с файлами как на твоем рисунке...
  Set f = ph.Files
  For Each q In f
    ListBox1.AddItem q.Name
  Next q
  a = "-=ßaßßßasüqß++üá´d´z" 'Текст в немецкой кодировке.
  b = "âê^qûî$fbv$"         'Текст в французской кодировке.
  TextBox1.Text = a
  TextBox2.Text = b
End Sub

Private Sub TextBox1_Change()
  a = TextBox1.Text
  TextBox2.Text = a
End Sub

Public Sub TestStrings()
    Dim str As String
    Const Bytes As Long = 16
    str = "AC-ïðî"
    Debug.Print String(Bytes * 3 + 18, "=")
    Debug.Print "ANSI    " & DumpANSI(str, Bytes)
    Debug.Print "Unicode " & DumpUnicode(str, Bytes)
End Sub

Private Function DumpANSI(ByRef str As String, ByRef Bytes As Long) As String
    Dim addr As Long
    CopyMemory addr, str, 4
    DumpANSI = HexDump(addr, Bytes)
End Function

Private Function DumpUnicode(ByRef str As String, ByRef Bytes As Long) As String
    DumpUnicode = HexDump(StrPtr(str), Bytes)
End Function

Private Function HexDump(ByRef addr As Long, ByRef Bytes As Long) As String
    Dim arr() As Byte
    Dim Iterator As Long
    If addr = 0 Then
        Err.Raise 5000, , "Not valid address."
    End If
    ReDim arr(Bytes - 1)
    CopyMemory arr(0), ByVal addr, Bytes
    For Iterator = 0 To (Bytes - 1)
        HexDump = HexDump & Right$("0" & Hex(arr(Iterator)), 2) & " "
    Next
    HexDump = "0x" & Right$("00000000" & Hex(addr), 8) & " " & HexDump
End Function

M>Самое главное, о чём я до этого не подозревал это то, что VB фактически хранит 2 (!) строки в разных местах:
M>1 — Однобайтовая (ANSI) строка. Для передачи в API типа FuncA
M>2 — Двухбайтовая (Unicode) строка для себя или для API ф-ий типа FuncW.
M>Проверить можно кодом ниже. Это ж какая расточительность, блин – на каждый символ 3 байта.

Private Declare Sub TestVarAnsi Lib "moddll" Alias "_TestVarAnsi@4" (ByVal pDoc As String)
Private Declare Sub TestVarUni Lib "moddll" Alias "_TestVarUni@4" (ByVal pDoc As Any)

Private Sub Form_Load()
  Dim s As String
  s = "abc"
  
  Call TestVarAnsi(s)
  Call TestVarUni(StrPtr(s))
  
  Unload Me
End Sub

__declspec(dllexport) void __stdcall TestVarAnsi(/*[in,out]*/ LPSTR pStatus )
{
    pStatus[1] = 'A';
    return;
}

__declspec(dllexport) void __stdcall TestVarUni(/*[in,out]*/ LPWSTR pStatus)
{
    pStatus[1] = 'B';
    return;
}

=================================================================================================
ByVal str         0x001E8384 41 42 43 00 00 00 31 00 38 00 34 00 00 00 00 00  |ABC   1 8 4      |
ByVal strptr(str) 0x001E7E74 41 00 42 00 43 00 00 00 6C 00 00 00 09 00 00 00  |A B C   l        |

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

    hFile = FreeFile
    Open sPath For Input As #hFile
        sText = Input(2, #hFile)
        If isUnicode(sText) Then
            sText = Input(LOF(hFile) / 2 - 1, #hFile)
        Else
            sText = sText & Input(LOF(hFile) - 2, #hFile)
        End If
    Close hFile

Private Function isUnicode(sText As String) As Boolean
    If Asc(sText) = 255 And Asc(Mid(sText, 2, 1)) = 254 Then
        isUnicode = True
    End If
End Function

Public Function Contents(ByRef FileName As String) As String
    Dim FileID As Long
    Dim cont() As Byte
    FileID = FreeFile()
    Open FileName For Binary As FileID
    ReDim cont(LOF(FileID))
    Get FileID, , cont()
    Contents = cont()
    Close FileID
End Function

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Count As Long)

    '**** Contents = cont()
    Dim Count As Long
    Count = UBound(cont()) - LBound(cont()) + 1
    If Count > 0 Then
        Contents = Space(Count / 2)
        CopyMemory ByVal StrPtr(Contents), cont(0), Count
    End If
    '***

M>Думаю, просто копируется побайтно (хм, или побайтово ? )

 sStr = sStr & "xxx"

M>Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Count As Long)

M>    '**** Contents = cont()
M>    Dim Count As Long
M>    Count = UBound(cont()) - LBound(cont()) + 1
M>    If Count > 0 Then
M>        Contents = Space(Count / 2)
M>        CopyMemory ByVal StrPtr(Contents), cont(0), Count
M>    End If
M>    '***
M>