CSV Datei via VBA in Excel einlesen

Hallo zusammen,

ich habe ein VBA-Sheet, mit der ich eine CSV Datei einlesen möchte, die dann als "Zielname".xlsx abgespeichert werden soll.
Automatisch öffnen, Speichern etc. Läuft bereits.

Soweit funktioniert das ganze auch ganz gut, nur möchte ich die CSV als "TEXT" einlesen und speichern, Excel formatiert mir aber die Zellen automatisch als Zahl und Datum, wie kann ich das umgehen? Bzw. abschalten?

Gruss
Jürgen

hier mein Code und die Beispielmappe

https://www.herber.de/bbs/user/159860.xlsm

Private Sub CSVBearb()

  Dim strTxt, Laufwerk, Pfad, zPfad, Dateiname, count, Spalt, unt As Integer
  Dim myarr, lngL As Long
  Dim strDatei, wks As Worksheet
  Laufwerk = ActiveWorkbook.Worksheets("Steuerung").Range("V2").Value
  Pfad = ActiveWorkbook.Worksheets("Steuerung").Range("V3").Value

  strPath = Pfad
  strExt = "*.csv"
  Dim strFile As String
  If strPath = "" Then
  Exit Sub
  Else
  strFile = Dir(strPath & strExt)
  zPfad = ActiveWorkbook.Worksheets("Steuerung").Range("V4").Value
  Dateiname = ActiveWorkbook.Worksheets("Steuerung").Range("V5").Value & Format(Date, "yyyymmdd") & "_"
  count = ActiveWorkbook.Worksheets("Steuerung").Range("V6").Value
  ActiveWorkbook.Worksheets("Steuerung").Range("V6").Value = count + 1
  
  Workbooks.OpenText Filename:=strPath & strFile, DataType:=xlDelimited, Semicolon:=True, Local:=True
      
  If ActiveWorkbook.Sheets(1).Range("A1").Value = "STOP" Then
    MsgBox "Prozess gestoppt"
  Else
      
  Dim AktSh As Variant
  AktSh = ActiveSheet.Name
  Spalt = ActiveWorkbook.Sheets(1).Cells(1, Columns.count).End(xlToLeft).Column
  ActiveWorkbook.Sheets(1).Activate
  ActiveSheet.Columns(Spalt).Delete
  unt = ActiveWorkbook.Sheets(1).Cells(Rows.count, 1).End(xlUp).Row
  ActiveWorkbook.Sheets(1).Range("A1:AZ" & unt).Select
  Dim Zelle As Range
  For Each Zelle In Selection
  Zelle = Zelle.Text
  Next Zelle
    
  ActiveWorkbook.Sheets(1).Range("G:I").Replace What:=".", Replacement:="-", LookAt:=xlPart
  
  ActiveWorkbook.SaveAs Filename:=zPfad & Dateiname & Format(count, "00000"), FileFormat:=xlOpenXMLWorkbook
  ActiveWorkbook.Close

  End If
  
  Dim Quelle As String
  Dim Ziel As String
  Quelle = strPath & strFile
  Ziel = strPath & "Save\" & strFile
  Name Quelle As Ziel
  
  End If
  
' hier Automatisch Schliessen und Speichern
 ' For Each w In Application.Workbooks
 ' w.Save
 ' Next w
 ' Application.Quit

End Sub