CSV Datei im Format Text mit Pipe und Office 2010

Sub SaveCSV()
    ' Speichert den Inhalt eines Arbeitsblatts als CSV-Datei   
    ' mit wählbarem Trennzeichen und Maskierung von Einträgen   
    ' von christian   
    ' Ohne Gewähr!   
     
    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.FullName
    strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")  
     
    strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", strMappenpfad)  
    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