VBA - Handling folder name with utf8 characters - vba

Question

I'm using Application.FileDialog(msoFileDialogFolderPicker) to pick a folder and it handles well folders with utf8 names.
But when I try to Debug.Print the result of SelectedItems(1) or save it to a config file or do anything, I loose the accents of the folder.
For example:
Original folder:
"D:\Śākta"
'Debug.Print' or saving into an utf8 file result saves:
"D:\Sakta" (removed all the accents)
The problem is that I try to save the selected folder to a config file and when I try to load it, next time it will of course won't recognize as a real folder because of the missing accents.
How to get the real name of the folder with the accents to be able to save it after, not this "representation" of it?
Update:
Just checked, and even the InputBox kills the accents!

Answer 1

#John Coleman's answer solved the issue switching the file saving to 'ADODB.Stream'
Here is an example of reading and writing config file supporting UTF8:
Public Function fileExists(ByVal fullFilename As String) As Boolean
fileExists = CreateObject("Scripting.FileSystemObject").fileExists(fullFilename)
End Function
Public Function ReadTextFile(ByVal sPath As String) As String
If fileExists(sPath) Then
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Mode = adModeRead
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
fsT.LoadFromFile (sPath)
ReadTextFile = fsT.ReadText
fsT.Close
Set fsT = Nothing
Else
ReadTextFile = ""
End If
End Function
Public Function WriteTextFile(ByVal s As String, ByVal sPath As String) As Boolean
Dim objStreamUTF8NoBOM: Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
fsT.WriteText s
fsT.Position = 0
fsT.SaveToFile sPath, 2 'Save binary data To disk
fsT.Position = 3
With objStreamUTF8NoBOM
.Type = 1
.Open
fsT.CopyTo objStreamUTF8NoBOM
.SaveToFile sPath, 2
Close
End With
fsT.Close
Set fsT = Nothing
Set objStreamUTF8NoBOM = Nothing
End Function
Function SetSettings(ByVal Keyname As String, ByVal Wstr As String) As String
Dim settingsFileContent
settingsFileContent = ReadTextFile(IniFileName)
Set RE = CreateObject("VBScript.RegExp")
RE.Pattern = Keyname + "=.*"
RE.MultiLine = 1
If RE.Test(settingsFileContent) Then
settingsFileContent = RE.Replace(settingsFileContent, Keyname + "=" + Wstr)
Else
settingsFileContent = settingsFileContent + IIf(Len(settingsFileContent) = 0, "", vbNewLine) + Keyname + "=" + Wstr
End If
WriteTextFile settingsFileContent, IniFileName
SetSettings = Wstr
End Function
Private Function GetSettings(ByVal Keyname As String) As String
Dim settingsFileContent As String
settingsFileContent = ReadTextFile(IniFileName)
Set RE = CreateObject("VBScript.RegExp")
RE.MultiLine = 1
RE.Global = 1
RE.Pattern = "\r"
settingsFileContent = RE.Replace(settingsFileContent, "")
RE.Global = 0
RE.Pattern = "^" + Keyname + "=(.*)"
Set allMatches = RE.Execute(settingsFileContent)
If allMatches.Count <> 0 Then
Debug.Print (Keyname + ": """ + allMatches.Item(0).SubMatches.Item(0) + """")
GetSettings = allMatches.Item(0).SubMatches.Item(0)
Else
GetSettings = ""
End If
End Function