Including special characters in Excel generated XML

[papusale]

I have a problem with the following:

Previously I got help from one of the Excelforum users in generating an XML based on a specific schema.
However this solution had a fault; the XML being generated did not support special characters (such as "ä","ö","å" and even "&").

Could somebody kindly help me with this issue?

The Module for generating XML is below and an example excel file along with the target XML schema attached.

Sub XMLFIle()
  Dim strXML As String
    'strXML = NavfGenerateXML(Selection, "IndividualAccounts")
    Dim HEADER As String
    Dim TAG_BEGIN  As String
    Dim TAG_END  As String
    Dim LC As Long
    Dim LR As Long
    Dim Btag As String
    Dim filenameinput As String
    Dim FPath As String, FName As String
'========================================
Dim Sht As Worksheet: Set Sht = ThisWorkbook.Sheets("Sheet1")
FPath = "C:\XML Creation"
FName = "XMLTest"
filenameinput = FPath & "\" & FName & ".xml"


HEADER = "<?xml version=""1.0"" encoding=""UTF-8"" ?>" & vbCrLf
strXML = HEADER
 
    
   TAG_BEGIN = "<Products>"
   TAG_END = "</Products>"

    strXML = strXML & TAG_BEGIN
    
    With Sht
        'Finding Last Row
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
                
        For i = 2 To LR
            strXML = strXML & vbCrLf & "<Product>"
            
            For j = 1 To LC
                If .Cells(i, j).Value = "" Then
                    strXML = strXML & vbCrLf & "<" & .Cells(2, j).Value & "/>"
                Else
                    strXML = strXML & vbCrLf & "<" & .Cells(1, j).Value & ">" & .Cells(i, j).Value & "</" & .Cells(1, j).Value & ">"
                End If
            Next
            j = 1
            strXML = strXML & vbCrLf & "</Product>"
        Next
   End With
   strXML = strXML & TAG_END
'=========================================
    sWriteFile strXML, filenameinput
    MsgBox ("Completed. XML Written to " & filenameinput)
End Sub
' Function for writing plain string out a file
Sub sWriteFile(strXML As String, strFullFileName As String)

    Dim intFileNum As String
    
    intFileNum = FreeFile
    Open strFullFileName For Output As #intFileNum
    Print #intFileNum, strXML
    Close #intFileNum
End Sub