Excel tabelle mit sonderzeichen via vba speichern

Hallo Zusammen,
Ich hoffe ihr könnt mir weiter helfen, mein Problem ist folgendes:
In meine Excel Tabelle sind viele Sonderzeichen und wenn ich das speichere mit mein Code werden alle sondere Zeichen nicht erkannt da erscheint nur ein frage Zeichen.
hat jemand ein Idee?
danke im Voraus.
Code:
Sub Speichern_Csv()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen

Dim Bereich As Object, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String

strMappenpfad = ActiveWorkbook.Name
strMappenpfad = Replace(strMappenpfad, ".xls", "")

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then Path = .SelectedItems(1)
End With
z = InputBox("Wie soll die CSV-Datei heißen?", "CSV-Export", strMappenpfad)
'Z = ActiveWorksheet.FullName , "CSV-Export", strMappenpfad

strDateiname = Path & "\" & z & ".txt"
If strDateiname = "" Then Exit Sub

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ";")
If strTrennzeichen = "" Then Exit Sub

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As #1

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname

End Sub

Set objFSO = CreateObject("Scripting.FileSystemObject")  
Set file = objFSO.CreateTextFile("c:\Unicode.txt", True, True)  
file.WriteLine "Häää Ösi is übel"  
file.Close

Sub Speichern_Csv()
' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei
' mit wählbarem Trennzeichen und Maskierung von Einträgen

Dim Bereich As Object, Zeile As Object, Zelle As Object, objFSO as Object, file als Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String

Set objFSO = CreateObject("Scripting.FileSystemObject")

strMappenpfad = ActiveWorkbook.Name
strMappenpfad = Replace(strMappenpfad, ".xls", "")

With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then Path = .SelectedItems(1)
End With
z = InputBox("Wie soll die CSV-Datei heißen?", "CSV-Export", strMappenpfad)

strDateiname = Path & "\" & z & ".txt"
If strDateiname = "" Then Exit Sub

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ";")
If strTrennzeichen = "" Then Exit Sub

Set file = objFSO.CreateTextFile(strDateiname, True, True)

Set Bereich = ActiveSheet.UsedRange

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
file.WriteLine strTemp
strTemp = ""
Next

file.Close
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname

End Sub