Speichern als csv

Sub Speichern_Csv_Test()
     ' 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 = ActiveSheet.Name
     
     strDateiname = Path & "\" & Z & ".csv"  
     If strDateiname = "" Then Exit Sub  
       
     strTrennzeichen = ";"  
     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
                 
                 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
     
       
 End Sub