Great question, here is a rudimentary way to do this:
Option Explicit
 
Public Enum abCharsets
    abError = 0
    abANSI = 1
    abUnicode = 2
    abUnicodeBigEndian = 3
    abUTF8 = 4
    ebUnknown = 5
End Enum
 
Public Sub Example()
    Dim objStream As ADODB.Stream
    Dim strPath As String
    strPath = "C:\test\Charset_Test\UTF8.txt"
    Set objStream = New ADODB.Stream
    With objStream
        .Open
        .Charset = CharsetToString(ReturnCharset(strPath))
        .LoadFromFile "C:\test\Charset_Test\UTF8.txt"
        MsgBox .ReadText
    End With
End Sub
 
Public Function ReturnCharset(ByVal filePath As String, Optional verifyANSI As Boolean = True) As abCharsets
    Const bytByte0Unicode_c As Byte = 255
    Const bytByte1Unicode_c As Byte = 254
    Const bytByte0UnicodeBigEndian_c As Byte = 254
    Const bytByte1UnicodeBigEndian_c As Byte = 255
    Const bytByte0UTF8_c As Byte = 239
    Const bytByte1UTF8_c As Byte = 187
    Const bytByte2UTF8_c As Byte = 191
    Const lngByte0 As Long = 0
    Const lngByte1 As Long = 1
    Const lngByte2 As Long = 2
    Dim bytHeader() As Byte
    Dim eRtnVal As abCharsets
    On Error GoTo Err_Hnd
    bytHeader() = GetFileBytes(filePath, lngByte2)
    Select Case bytHeader(lngByte0)
    Case bytByte0Unicode_c
        If bytHeader(lngByte1) = bytByte1Unicode_c Then
            eRtnVal = abCharsets.abUnicode
        End If
    Case bytByte0UnicodeBigEndian_c
        If bytHeader(lngByte1) = bytByte1UnicodeBigEndian_c Then
            eRtnVal = abCharsets.abUnicodeBigEndian
        End If
    Case bytByte0UTF8_c
        If bytHeader(lngByte1) = bytByte1UTF8_c Then
            If bytHeader(lngByte2) = bytByte2UTF8_c Then
                eRtnVal = abCharsets.abUTF8
            End If
        End If
    End Select
    If Not CBool(eRtnVal) Then
        If verifyANSI Then
            If IsANSI(filePath) Then
                eRtnVal = abCharsets.abANSI
            Else
                eRtnVal = abCharsets.ebUnknown
            End If
        Else
            eRtnVal = abCharsets.abANSI
        End If
    End If
Exit_Proc:
    On Error Resume Next
    Erase bytHeader
    ReturnCharset = eRtnVal
    Exit Function
Err_Hnd:
    eRtnVal = abCharsets.abError
    Resume Exit_Proc
End Function
 
Private Function IsANSI(ByVal filePath As String) As Boolean
    Const lngKeyCodeNullChar_c As Long = 0
    Dim bytFile() As Byte
    Dim lngIndx As Long
    Dim lngUprBnd As Long
    bytFile = GetFileBytes(filePath)
    lngUprBnd = UBound(bytFile)
    For lngIndx = 0 To lngUprBnd
        If bytFile(lngIndx) = lngKeyCodeNullChar_c Then
            Exit For
        End If
    Next
    Erase bytFile
    IsANSI = (lngIndx > lngUprBnd)
End Function
 
Public Function GetFileBytes(ByVal path As String, Optional ByVal truncateToByte As Long = -1) As Byte()
    Dim lngFileNum As Long
    Dim bytRtnVal() As Byte
    If truncateToByte < 0 Then
        truncateToByte = FileLen(path) - 1
    End If
    lngFileNum = FreeFile
    If FileExists(path) Then
        Open path For Binary Access Read As lngFileNum
        ReDim bytRtnVal(truncateToByte) As Byte
        Get lngFileNum, , bytRtnVal
        Close lngFileNum
    End If
    GetFileBytes = bytRtnVal
    Erase bytRtnVal
End Function
 
Public Function FileExists(ByVal filePath As String) As Boolean
    FileExists = CBool(LenB(Dir(filePath, vbHidden + vbNormal + vbSystem + vbReadOnly + vbArchive)))
End Function
Public Function CharsetToString(ByVal value As abCharsets) As String
    Dim strRtnVal As String
    Select Case value
        Case abCharsets.abANSI
            strRtnVal = "us-ascii"
        Case abCharsets.abUTF8
            strRtnVal = "utf-8"
        Case Else
            strRtnVal = "Unicode"
    End Select
    CharsetToString = strRtnVal
End Function