Grosmar
Grosmar

Reputation: 167

VBA - Handling folder name with utf8 characters

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!

Upvotes: 1

Views: 552

Answers (1)

Grosmar
Grosmar

Reputation: 167

@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

Upvotes: 1

Related Questions