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
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