Search code examples
vbacharacter-encoding

VBA - Writing to textfile with CP437 (ASCII Extended)


I'm looking for a way to transfer data to a textfile with the characterset CP437 using VBA. More info about the charset: https://www.ascii-code.com/CP437

For simplicity i have only one row that will be printed in the code below but in reality its around 1 million rows of data containing more info.

Anyone know how to get this working? I could get the characters correct if I use utf-8 but then I don't adhere to the standars of SIE files. https://sie.se/in-english/

Tried to find it in the registry as that should be whats possible to write: HKEY_CLASSES_ROOT\MIME\Database\Charset https://learn.microsoft.com/en-us/sql/ado/reference/ado-api/charset-property-ado?view=sql-server-ver16

Sub Test()
    Dim fsT As Object: Set fsT = CreateObject("ADODB.Stream")
    fsT.Type = adTypeText
    fsT.Charset = "ASCII"
    fsT.Open
    fsT.WriteText "#FNAMN " & """Test åäö""" & Chr(10)
    fsT.SaveToFile newFilePath, adTypeText
End Sub

Solution

  • Yes, this is possible by using some API functions. I recently wrote a VBA library that wraps these API functions for Windows and Mac and provides an OS-independent API for transcoding strings.

    Take a look at it here: VBA-StringTools

    Unfortunately, I didn't get to write separate documentation for the library yet, but the code is documented in banner comments above the individual procedures. I will also give you some code you can try right here.

    The idea is to do all the transcoding in VBA using API functions and then write the resulting bytes to a file.

    As you may know, normal VBA strings are UTF-16LE encoded internally, so if your data comes from VBA or Excel, you can just use the Encode function from the library (it assumes UTF-16LE input), otherwise if you know your data is encoded differently already, just use the Transcode function.

    This sub demonstrates the usage of Encode:

    Sub ExampleSub()
        Dim vbaString As String
        vbaString = "#FNAMN " & """Test åäö""" & Chr(10)
        
       'Note:
       'Requires library VBA-StringTools: https://github.com/guwidoe/VBA-StringTools
       'Encode() returns a String, but String can be assigned to Byte() in VBA
        Dim b() As Byte: b = Encode(vbaString, cpIBM437)
                        'b = Transcode(vbaString, cpUTF_16, cpIBM437) 'Alterative
        
        Dim path As String
        path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\File.txt"
        
        Dim fileNum As Long: fileNum = FreeFile
        Open path For Binary Access Write As #fileNum
            Put #fileNum, 1, b
        Close #fileNum
    End Sub