Hallo,
vielen Dank für die schnekke Antwort.
Nun meckert er aber folgende Zeile:
strTemp = strTemp & """" & Utf8BytesFromString(Zelle.Text) & """" & strTrennzeichen
Folgender Fehler: Typen unvertäglich >>> Geht um das & zwischen """" & Utf8BytesFromString(Zelle.Text)
Hier der vollständige Code:
''' WinApi function that maps a UTF-16 (wide character) string to a new character string
Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cbMultiByte As Long, _
ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long) As Long
' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001
''' Return byte array with VBA "Unicode" string encoded in UTF-8
Public Function Utf8BytesFromString(strInput As String) As Byte()
Dim nBytes As Long
Dim abBuffer() As Byte
' Get length in bytes *including* terminating null
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, vbNull, 0&, 0&, 0&)
' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
ReDim abBuffer(nBytes - 2) ' NB ReDim with one less byte than you need
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
Utf8BytesFromString = abBuffer
End Function
Sub ExportCSV()
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
Dim blnAnfuehrungszeichen As Boolean
strMappenpfad = ActiveWorkbook.Path + "\" + Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) + ".csv"
strDateiname = InputBox("Bitte den Namen der CSV-Datei angeben.", "CSV-Export", strMappenpfad)
If strDateiname = "" Then Exit Sub
strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub
If MsgBox("Sollen die Werte in Anführungszeichen exportiert werden?", vbQuestion + vbYesNo, "CSV-Export") = vbYes Then
blnAnfuehrungszeichen = True
Else
blnAnfuehrungszeichen = False
End If
Set Bereich = ActiveSheet.UsedRange
Open strDateiname For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If blnAnfuehrungszeichen = True Then
strTemp = strTemp & """" & Utf8BytesFromString(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & Utf8BytesFromString(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 "Export erfolgreich. Datei wurde exportiert nach" & vbCrLf & strDateiname
End Sub
|