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