Check the file encode type?

[wing_hk]

Is there any way to check the file encode type? (ANSI or Unicode / UTF=8 etc)

This can be simply checked by open the file with NOTEPAD and click SAVEAS, then check in the "ENCODE" field.

Just don't know how to check it with vba, I have tried "ADODB.Stream.Charset" but it always return "Unicode" for all files with different encoder. And "Scripting.FileSystemObject" also can't do that.

Any idea?

[Oorang]

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

[wing_hk]

Thanks you so much, I've tested with the files and here below's the result:

XML File:
ANSI / Unicode: 5


TEXT File:
ANSI: 5
Unicode: 2
UTF-8: 4

According to the result code definetion, the code works well with TXT file (Except ANSI) but not XML file. And if strPath is pointing to a file doesn't exist, a file with same name and zero size will be created (This can be solved by "(Dir(strPath) > "")" check at beginning)

abANSI = 1
abUnicode = 2
abUnicodeBigEndian = 3
abUTF8 = 4
ebUnknown = 5

[Oorang]

Good catches. Fixed

[wing_hk]

Thanks so much! It really works for XML and TXT files now.

I also find some problems are from my XML files which are auto-generated and zipped from SUN Microsystems. I have to unzip, open and save (without change) to make VBA return correct charset.


I am sure if I should open a new post: (I will if you suggest)

(1) Just quick open and save files:
Use ADODB.Stream right? or any better suggestion?

(2) Save with another encoder
Is "ADODB.Stream.Charset" the best way to do it?

[Oorang]

I've updated the code in above to include an example of how to make it all work with an ado stream. As far as "better" goes, it depends on the requirements. The ado stream object should be fine for most of your needs. Unless you find plan on optimizing for speed, I'd stick with it But ado should be fast enough for the majority of tasks I could forsee.

[wing_hk]

Great works !

[Ove.Halseth]

Thanks for some great code!

I only needed one change.

I guess in europe this line:
strRtnVal = "us-ascii"
should be:
strRtnVal = "windows-1252"