Zurück zur Homepage

UTF-8 Datei nach Char

XML- oder .CSV - Dateien werden häufig in UTF-8 codiert. Von Notepad oder Word werden diese Dateien an der ersten drei Bytes erkannt und richtig dargestellt. Excel kann das leider nicht, aber man kann eine Datei programmgesteuert vorher umwandeln.

Unter Punkt 22 finden Sie auch Code zum Umwandeln von OEM nach CHAR.

Beispieldatei (UTF8.zip 9 kB) 

 

Option Explicit

Private Declare Function CreateFile _
   
Lib "kernel32" Alias "CreateFileA" ( _
   
ByVal lpFileName As String, _
   
ByVal dwDesiredAccess As Long, _
   
ByVal dwShareMode As Long, _
   
ByVal lpSecurityAttributes As Long, _
   
ByVal dwCreationDisposition As Long, _
   
ByVal dwFlagsAndAttributes As Long, _
   
ByVal hTemplateFile As Long _
   ) 
As Long
   
Private Declare Function SetFilePointer _
   
Lib "kernel32" ( _
   
ByVal hFile As Long, _
   
ByVal lDistanceToMove As Long, _
   lpDistanceToMoveHigh 
As Long, _
   
ByVal dwMoveMethod As Long _
   ) 
As Long
   
Private Declare Function SetEndOfFile _
   
Lib "kernel32" ( _
   
ByVal hFile As Long _
   ) 
As Long
   
Private Declare Function CloseHandle _
   
Lib "kernel32" ( _
   
ByVal hObject As Long _
   ) 
As Long

Private Declare Function MultiByteToWideChar _
   
Lib "kernel32" ( _
   
ByVal CodePage As Long, _
   
ByVal dwFlags As Long, _
   
ByVal lpMultiByteStr As Long, _
   
ByVal cchMultiByte As Long, _
   
ByVal lpWideCharStr As Long, _
   
ByVal cchWideChar As Long _
   ) 
As Long
   
Private Const CP_UTF7 = 65000
Private Const CP_UTF8 = 65001
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_WRITE = &H2
Private Const FILE_SHARE_READ = &H1
Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1
Private Const FILE_END = 2



Public Function ConvertFromUTF8(abytSource() As ByteAs String
Dim abytBuff() As Byte
Dim lngLen     As Long
On Error Resume Next

' Buffer anlegen
lngLen = 
UBound(abytSource) + 1
ReDim abytBuff(0 To lngLen)

' Umwandeln
lngLen = MultiByteToWideChar( _
   CP_UTF8, _
   0, _
   VarPtr(abytSource(0)), _
   lngLen, _
   VarPtr(abytBuff(0)), _
   lngLen)
   
ConvertFromUTF8 = abytBuff

' Kürzen bei CHR(0)
ConvertFromUTF8 = Left(ConvertFromUTF8, _
   InStr(1, ConvertFromUTF8, Chr(0)) - 1)
   
End Function

'Konvertiert Textdatei
Public Sub UTF8Umwandeln()
Dim strFile                As String
Dim lngFileLen             As Long
Dim abytText()             As Byte
Dim lngFF                  As Long
Dim strDest                As String
Dim lngFile                As Long
Dim lngRet                 As Long
Dim lngAccess              As Long
Dim lngShare               As Long
Dim abytSignature(0 To 2)  As Byte


' Filename holen
strFile = Application.GetOpenFilename( _
   
"Textdateien (*.csv ; *.txt),*.csv ; *.txt")
   
If (LCase(strFile) = "falsch"Or _
   (LCase(strFile) = 
"false"Then Exit Sub
   
lngFF = FreeFile

Open strFile For Binary As lngFF

   
' Kennung für UTF-8 lesen
   
Get lngFF, , abytSignature
   
   
' Überprüfen, ob UTF-8
   
If (abytSignature(0) <> 239) Or _
     (abytSignature(1) <> 187) 
Or _
     (abytSignature(2) <> 191) 
Then
     
     MsgBox 
"Kein UTF-8!"
     
Close lngFF
     
Exit Sub
     
   
End If
   
   
' Länge Buffer ermitteln
   lngFileLen = LOF(lngFF) - 3
   
   
' ByteBuffer anlegen
   
ReDim abytText(0 To lngFileLen)

   
' Text auslesen
   
Get lngFF, 4, abytText
   
   
' Umwandeln
   strDest = ConvertFromUTF8(abytText)
   
   
' Datei nachher auf diese Länge kürzen
   lngFileLen = Len(strDest)
   
   
' Umgewandeltes zurückschreiben
   
Put lngFF, 1, ConvertFromUTF8(abytText)

Close lngFF

' Datei kürzen, ohne zu löschen und neu
' anzulegen

' Filehandle holen
lngFile = CreateFile(strFile, GENERIC_WRITE, _
    FILE_SHARE_WRITE, 
ByVal 0&, OPEN_EXISTING, 0&, 0&)

'Position setzen
SetFilePointer lngFile, lngFileLen, 0&, FILE_BEGIN

'EOF setzen
SetEndOfFile lngFile

'Filehandle schließen
CloseHandle lngFile

End Sub