Xls to CSV mit makro

Private Sub Workbook_Open()
    ChDir "c:\temp"  
    Workbooks.Open Filename:="c:\temp\test.xls"  
    ActiveWorkbook.SaveAs Filename:="c:\temp\test.csv", _  
    FileFormat:=xlCSV, CreateBackup:=False
End Sub

Sub Sheet_Nach_CSVDatei()
'hierbei bleibt die Formatierung der Zellen so wie sie angezeigt wird.  
'Es muss alles so formatiert sein wie es später In der CSV sein soll.  
Dim vntFileName As Variant
Dim lngFn As Long
Dim rngRow As Excel.Range
Dim rngCell As Excel.Range
Dim strDelimiter As String
Dim strText As String
Dim strTextCell As String
Dim bolErsteSpalte As Boolean
Dim rngColumn As Excel.Range
Dim wksQuelle As Excel.Worksheet

strDelimiter = ";" 'deutsches CSV-Format: ";", Englishes CSV-Format: ","  

vntFileName = Application.GetSaveAsFilename("Test.csv", _  
    FileFilter:="CSV-File (*.csv),*.csv")  
If vntFileName = False Then Exit Sub

Set wksQuelle = ActiveWorkbook.Worksheets("Tabelle1")  'Beispiel oder: = ActiveSheet  

lngFn = FreeFile
Open vntFileName For Output As lngFn
 For Each rngRow In wksQuelle.UsedRange.Rows 
  strText = ""  
  bolErsteSpalte = True
  For Each rngCell In rngRow.Columns
   strTextCell = rngCell.Text 'Text! inclusive dem NumberFormat der Zelle  
   If InStr(1, strTextCell, strDelimiter, 0) Then '## wenn alle Zellen mit " " eingeschlossen werden sollen zeile auskommentieren  
    'bewirkt das Werte die den Delimiter enthalten (was eigentlich nicht sein sollte) mit " " eingeschlossen werden  
    strTextCell = Chr(34) & strTextCell & Chr(34)
   End If '##  
   If bolErsteSpalte Then
    strText = strTextCell
    bolErsteSpalte = False
   Else
    strText = strText & strDelimiter & strTextCell
   End If
  Next
  Print #lngFn, strText
 Next
Close lngFn
 
End Sub