Tabellenblatt als UTF-8 Text speichern

[JonAegon]

Hey Leute ich brauche dringend eure Unterstützung. Nach langer Suche in diversen Suchen, hab ich zwar immer wieder was gefunden, konnte damit aber leider nichts anfangen. Hoffe ihr könnt mir daher helfen.
Ich habe eine simple Excel-Tabelle, Tabellenname "Tabelle1" mit einfachen Daten in mehreren Zeilen und Spalten. Diese Tabelle möchte ich nun gerne über VBA als Text-Datei abspeichern, diese müsste jedoch im Format UTF-8 BOM sein. Dei Einstellung "UnicodeText" gibt leider nur das Format UTF-16 aus... Hat da jemand eine Idee für mich?

Hier mal meinen Code:

Code:

Sub Einzelnes_Blattspeichern()
Dim s As String
s = ActiveWorkbook.Name
'akltuelles Blatt in neue Mappe kopieren
ActiveSheet.Copy
Application.DisplayAlerts = False
'Speicherung
    ActiveWorkbook.SaveAs Filename:="G:\....\....\....\" _
        & ActiveSheet.Name & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=False
'Schließen der Arbeitsmappe
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

[Sigi.21]

Hi,

warum nimmst du nicht das Datei-Format ...
FileFormat:=xlCSVUTF8

Sigi

[Kuwer]

Hallo,

hier siehst Du alle verfügbaren Fileformate: https://docs.microsoft.com/de-de/office/...fileformat

Gruß Uwe

[JonAegon]

Danke für die schnellen Antworten...ja hab ich schon probiert aber dann speichert er mir die spalten mit kommata, diese möchte ich gerne, habe ich vergessen zu erwähnen, als tab-trennung.

Nachtrag: Habe das ganze jetzt über die Lokale listentrennung hinbekommen mit dem Zusatz  Local:=True.
Jetzt habe ich nur noch eine Sache und zwar die setzung von Anführungszeichen "", sollen vermieden werden, war könnte ich das hinbekommen?

[00202]

Hallo,  

du könntest es mit "ADODB.Stream" probieren. Da hast du alle Möglichkeiten.

[schauan]

Hallöchen,

das könnte ungefähr so aussehen

Code:

Sub DatenExportieren()
  'Variablendeklarationen
  Dim UTFStream As Object, iCnt1%, iCnt2%, lCols&, lRows&
  Dim strFileName$, strSheetName$, strPath$
  'Ausgabedatei und Datenblattname festlegen
  strPath = "C:\Temp\"
  strFileName = "Test"
  strSheetName = "Tabelle1"
  'Objekt initialisieren
  Set UTFStream = CreateObject("adodb.stream")
  'Objekteigenschaften festlegen
  UTFStream.Type = adTypeText
  UTFStream.Mode = adModeReadWrite
  UTFStream.Charset = "UTF-8"
  UTFStream.LineSeparator = adLF
  UTFStream.Open
  'Mit dem Datenblatt ...
  With Sheets(strSheetName)
    'bei Fehler weiter
    On Error Resume Next
    'Zellen mit Fehlern leeren
    .Cells.SpecialCells(Type:=xlCellTypeFormulas, Value:=xlErrors).Value = ""
    .Cells.SpecialCells(Type:=xlCellTypeConstants, Value:=xlErrors).Value = ""
    'Ende bei Fehler weiter
    On Error GoTo 0
    'Datenbereich Spalten und Zeilen ermitteln
    lCols = .Cells(1, Columns.Count).End(xlToLeft).Column
    lRows = .Cells(Rows.Count, 1).End(xlUp).Row
    'Schleife ueber den Datenbereich
    For iCnt1 = 1 To lRows
      For iCnt2 = 1 To lCols
        'Spaltenverarbeitung
        'wenn Spaltenzaehler kleiner als max. Spaltenzahl, dann
        If iCnt2 < lCols Then
          'Zellinhalt uebernehmen, Semikon durch Komma ersetzen und Semikolon als Abschluss
          UTFStream.WriteText Replace(.Cells(iCnt1, iCnt2).Value, ";", ",") & ";"
        'oder bei / nach letzter Spalte
        Else
          'Zellinhalt uebernehmen, Semikon durch Komma ersetzen und Zeilenvorschub setzen
          UTFStream.WriteText Replace(.Cells(iCnt1, iCnt2).Value, ";", ",") & vbLf
        End If
      Next iCnt1
    Next iCnt2
  'Ende Mit dem Datenblatt ...
  End With
  'Dateiausgabe
  UTFStream.Position = 3 'skip BOM
  Dim BinaryStream As Object
  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open
  'Strips BOM (first 3 bytes)
  UTFStream.CopyTo BinaryStream
  'Pfad pruefen, wenn vorhanden dann Datei ausgeben, sonst nur Meldung
  If Dir(strPath, vbDirectory) <> "" Then
    BinaryStream.SaveToFile strPath & LCase(strFileName) & ".csv", adSaveCreateOverWrite
    BinaryStream.Flush
  Else
    MsgBox "Pfad zur Ausgabe nicht vorhanden!" & vbLf & strPath & LCase(strFileName) & ".csv"
  'Ende Pfad pruefen, wenn vorhanden dann Datei ausgeben, sonst nur Meldung
  End If
  BinaryStream.Close
End Sub

[snb]

Code:

Sub M_snb()
  Sheet1.UsedRange.Copy
 
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    c00 = .GetText
  End With
 
  CreateObject("scripting.filesystemobject").createtextfile("G:\OF\beispiel.txt", , True).write c00
End Sub