vb-Zentrum
Unicode Dateihandling
http://www.vb-zentrum.de/unidateihandling.html

© 2016 vb-Zentrum

Unicode Dateihandling

Die Dateifunktionen in VBA unterstützen ausnahmslos kein Unicode. Hier finden Sie entsprechende Ersatzlösungen.

Um die Unicode Implementierung so einfach wie möglich zu gestalten haben einige Funktionen den gleichen Namen, wie das VBA Original. Diese Funktionen sind im Titel mit "(VBA-Overwrite)" gekennzeichnet! Wenn Sie also die hier beschriebenen Funktionen in Ihren Code einfügen, so werden durch diese Technik die VBA Funktionen gewissermaßen überschrieben; d.h.:

Ihr Code muss nicht verändert werden und unterstützt ab sofort Unicode!

In dieser Rubrik unterscheiden wir Funktionen die mit Unicode Dateinamen arbeiten (ab Tipp 0001)
und Funktionen die mit Unicode Dateiinhalten arbeiten (ab Tipp 1001).

Vorbedingungen

Viele der folgenden Beispiele benutzen die globale, boolsche Variable isUnicode, sowie die Compiler Konstante #ANSISupport.

Beide sind in den folgenden Beispielen aus Platzgründen nicht enthalten und werden deshalb hier zentral beschrieben:

  • Compiler Konstante #ANSISupport
    hiermit wird projektweit entschieden, ob Ihre Anwendung auch auf Systmen vor Windows 2000 laufen soll (#ANSISupport <> 0).
    Um die ANSI Unterstützung zu aktivieren gehen Sie folgendermaßen vor:

    rufen Sie in der IDE den Dialog der Projekteigenschaften auf (Menü: "Projekt" -> "Eigenschaften von [Projektname]...")
    Wechseln Sie auf die Registerkarte "Erstellen"
    Geben Sie in das Feld "Argumente für bedingte Kompilierung" folgenden Text ein: ANSISupport = 1
  • Globale Variable isUnicode
    Wenn die Compiler Konstate #ANSISupport <> 0 ist: dann wird die ANSI Variante auf Nicht-NT-System benutzt,
    anderenfalls die UNICODE Variante.

Deshalb muss diese Variable in einem Modul angelegt werden und über folgende Funktion vor allen weiteren Aufrufen initialisiert werden:

Option Explicit

Public isUnicode As Boolean

' Deklaration:
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Long

' Typendefinition:
Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Private Const VER_PLATFORM_WIN32_NT = 2


' Funktion:
' Prüft auf NT-Betriebssysteme: True ab Windows NT/2000 und neuer, sonst False
Public Function isSystemNT() As Boolean
  Dim info As OSVERSIONINFO

  info.dwOSVersionInfoSize = Len(info)
  GetVersionExA info
  isSystemNT = (info.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function

' Initialisierungs-Aufruf:
isUnicode = isSystemNT()

Übrigens: wenn Sie die Beispiele nicht einzelnd kopieren möchten, können Sie auch das fertige Modul vbzGlobal.bas herunterladen.
Darin ist (fast) alles enthalten, was hier zu finden ist. Benutzen Sie diese Tipp-Seite dann einfach als erweiterte Dokumentation...

Nach oben

0001 file_exist - eine bestimmte Datei auf Existenz prüfen

In nahezu jedem Programm benötigt. Hier die wohl schnellste Variante, die das Vorhandensein über das Dateiattribut abfragt. Nachteil: es muß ein kompletter Dateiname übergeben werden, die Verwendung von s.g. Wildcards (? und * im Dateinamen) ist nicht zulässig:

  • Beachten Sie die Vorbedingungen
  • Diese Funktion ist Bestandteil des Moduls vbzGlobal.bas, das sie hier kostenlos herunterladen können.
Private Declare Function GetFileAttributesA Lib "kernel32" (ByVal lpFileName As String) As Long
Private Declare Function GetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long) As Long
Private Const INVALID_FILE_ATTRIBUTES As Long = -1

Public Function file_exist(ByVal file As String) As Boolean
  Dim dwAttributes As Long
  
  If (file = vbNullString) Then Exit Function
  #If ANSISupport Then
    If isUnicode Then
      dwAttributes = GetFileAttributesW(StrPtr(file))
    Else
      dwAttributes = GetFileAttributesA(file)
    End If
  #Else
    dwAttributes = GetFileAttributesW(StrPtr(file))
  #End If
  If dwAttributes = INVALID_FILE_ATTRIBUTES Then
    file_exist = False
  Else
    file_exist = (dwAttributes And vbDirectory) = 0
  End If
End Function
 

Autor: Ralf Schlegel
Stand: 12/2012

Nach oben

0002 anyfile_exist - eine Datei auf Existenz prüfen

In nahezu jedem Programm benötigt. Hier die etwas aufwendigere Alternative zu Tipp 0001 mit Unterstützung
von Wildcards (? und * im Dateinamen).
Angenehm: die Struktur WIN32_FIND_DATA kann ausnahmsweise für die ANSI und Unicode Variante benutzt werden:

  • Beachten Sie die Vorbedingungen
  • Diese Funktion ist Bestandteil des Moduls vbzGlobal.bas, das sie hier kostenlos herunterladen können.
Public Const MAX_PATH As Long = 260
Public Const INVALID_HANDLE_VALUE As Long = -1

Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
  FileAttributes As Long
  CreationTime As FILETIME
  LastAccessTime As FILETIME
  LastWriteTime As FILETIME
  nFileSizeBig As Currency
  Reserved0 As Long
  Reserved1 As Long
  FileName As String * MAX_PATH
  AlternateFileName As String * 14
End Type

#If ANSISupport Then
  Public Declare Function FindFirstFileA Lib "kernel32" _
                 (ByVal lpFileName As String, lpFFData As WIN32_FIND_DATA) As Long
#End If
Public Declare Function FindFirstFileW Lib "kernel32" _
               (ByVal lpFileName As Long, ByVal lpFFData As Long) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Public Function anyfile_exist(ByVal file As String) As Boolean
  Dim hFile As Long
  Dim FD As WIN32_FIND_DATA
  
  #If ANSISupport Then
    If isUnicode Then
      hFile = FindFirstFileW(StrPtr(file), VarPtr(FD))
    Else
      hFile = FindFirstFileA(file, FD)
    End If
  #Else
    hFile = FindFirstFileW(StrPtr(file), VarPtr(FD))
  #End If
  If hFile <> INVALID_HANDLE_VALUE Then
    anyfile_exist = True
    FindClose hFile
  End If
End Function

 

Autor: Ralf Schlegel
Stand: 12/2012

Nach oben

0003 GetAttr und SetAttr - erweiterte Dateiattribute (VBA-Overwrite)

Die VBA Funktionen GetAttr und SetAttr sind definitiv veraltet: unterstützen kein Unicode und keine Netzwerkpfade, außerdem stehen neuere Attribute, wie z.B.: compressed, nicht direkt in der Eingabe zur Verfügung, da sie in der Enumeration des alten VBA nicht angelegt wurden.

Der folgende Codeabschnitt zeigt den besser funktionierenden API-Ersatz, der neben Unicode auch UNC-Path unterstützt! Der übergebene Dateiname ist außerdem nicht mehr auf MAX_PATH (256-Zeichen) beschränkt und ''\\Servername\Verzeichnis1\MeineDatei.dat'' kann auch als Dateiname übergeben werden.

  • Beachten Sie die Vorbedingungen
  • Diese Funktion ist Bestandteil des Moduls vbzGlobal.bas, das sie hier kostenlos herunterladen können.
#If ANSISupport Then
  Private Declare Function GetFileAttributesA Lib "kernel32" (ByVal lpFileName As String) As Long
  Private Declare Function SetFileAttributesA Lib "kernel32" (ByVal lpFileName As String, _
                           ByVal dwFileAttributes As Long) As Long
#End If
Private Declare Function GetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long) As Long
Private Declare Function SetFileAttributesW Lib "kernel32" (ByVal lpFileName As Long, _
                         ByVal dwFileAttributes As Long) As Long

Public Enum vbzFileAttrib
  FILE_ATTRIBUTE_READONLY = &H1
  FILE_ATTRIBUTE_HIDDEN = &H2
  FILE_ATTRIBUTE_SYSTEM = &H4
  FILE_ATTRIBUTE_VOLUME = &H8           ' Readonly Attribut! do not use with "SetAttr"!
  FILE_ATTRIBUTE_DIRECTORY = &H10
  FILE_ATTRIBUTE_ARCHIVE = &H20
  FILE_ATTRIBUTE_ALIAS = &H40
  FILE_ATTRIBUTE_NORMAL = &H80
  FILE_ATTRIBUTE_TEMPORARY = &H100
  FILE_ATTRIBUTE_REPARSE_POINT = &H400
  FILE_ATTRIBUTE_COMPRESSED = &H800
  FILE_ATTRIBUTE_OFFLINE = &H1000
  FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
  FILE_ATTRIBUTE_ENCRYPTED = &H4000
End Enum

Public Function GetAttr(ByVal fName As String) As vbzFileAttrib
  #If ANSISupport Then
    If isUnicode Then
      If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
      GetAttr = GetFileAttributesW(StrPtr("\\?\" & fName))
    Else
      GetAttr = GetFileAttributesA(fName)
    End If
  #Else
    If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
    GetAttr = GetFileAttributesW(StrPtr("\\?\" & fName))
  #End If
End Function

Public Function SetAttr(ByVal fName As String, ByVal Attributes As vbzFileAttrib) As Boolean
  #If ANSISupport Then
    If isUnicode Then
      If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
      SetAttr = CBool(SetFileAttributesW(StrPtr("\\?\" & fName), Attributes))
    Else
      SetAttr = CBool(SetFileAttributesA(fName, Attributes))
    End If
  #Else
    If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3)
    SetAttr = CBool(SetFileAttributesW(StrPtr("\\?\" & fName), Attributes))
  #End If
End Function
 

Autor: Ralf Schlegel
Stand: 12/2012

Nach oben

0004 FileLen - auch für Dateien über 4GB (VBA-Overwrite)

Die VBA Funktion FileLen ermittelt die Dateigröße in Bytes und gibt diese als Longwert zurück. Aufgrund des Datentyps Long liegt die erfassbare Grenze bei knapp 4 GByte, was im Zuge der ständig steigenden Multimedia-Dateiqualität oftmals nicht mehr ausreicht! Das hat auch Microsoft erkannt und stellt deshalb bereits seit Windows 2000 die API-Funktion GetFileSizeEx zur Verfügung, die einen LARGE_INTEGER Wert zurückgibt, den wir VB-ler mit dem Datentyp Currency verarbeiten können; zur Erinnerung (Auszug aus der MSDN):
Variablen vom Datentyp Currency werden als 64-Bit-Zahlen (8 Bytes) in einem ganzzahligen Format gespeichert und durch 10.000 dividiert, was eine Festkommazahl mit 15 Vorkomma- und 4 Nachkommastellen ergibt. Diese Darstellung ergibt einen Wertebereich von -922.337.203.685.477,5808 bis 922.337.203.685.477,5807.

Wir deklarieren also die nötigen API-Funktionen und bauen uns eine eigene FileLen Funktion, die die vorhandene VBA-Funktion überschreibt - so müssen wir nichts weiter an unserem Programmcode ändern. Achten Sie aber darauf, das die Variable, die die Dateigröße aufnehmen soll vom Typ Long auf Currency geändert werden muss!

  • Beachten Sie die Vorbedingungen
  • Diese Funktion ist Bestandteil des Moduls vbzGlobal.bas, das sie hier kostenlos herunterladen können.
#If ANSISupport Then
  Private Declare Function CreateFileA Lib "kernel32" (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
#End If
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, _
        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 GetFileSizeEx Lib "kernel32" (ByVal hFile As Long, _
        lpFileSize As Currency) As Boolean
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1&
Private Const OPEN_EXISTING = &H3

' FileLen: get the file size in bytes (VBA-Overwrite)
Public Function FileLen(ByVal fName As String) As Currency
  Dim fHandle As Long
  Dim fileSize As Currency
  
  #If ANSISupport Then
    If isUnicode Then
      fHandle = CreateFileW(StrPtr(fName), GENERIC_READ, FILE_SHARE_READ, _
                            ByVal 0&, OPEN_EXISTING, 0&, 0&)
    Else
      fHandle = CreateFileA(fName, GENERIC_READ, FILE_SHARE_READ, _
                            ByVal 0&, OPEN_EXISTING, 0&, 0&)
    End If
  #Else
    fHandle = CreateFileW(StrPtr(fName), GENERIC_READ, FILE_SHARE_READ, _
                          ByVal 0&, OPEN_EXISTING, 0&, 0&)
  #End If
  If fHandle > 0 Then
    If GetFileSizeEx(fHandle, fileSize) Then
      FileLen = fileSize * 10000
    End If
    Call CloseHandle(fHandle)
  End If
End Function
Autor: ralf schlegel
Stand: 01/2013

0005 file_properties - der Dialog Dateieigenschaften

Die Dateieigenschaften anzeigen wie im Windows-Explorer mit der Funktion "file_properties". Übergeben Sie der Funktion einfach einen Datei- oder Ordnernamen.

  • Beachten Sie die Vorbedingungen
  • Diese Funktion ist Bestandteil des Moduls vbzGlobal.bas, das sie hier kostenlos herunterladen können.
' file properties:
Private Declare Function ShellExecuteExA Lib "shell32" (ShellExInfo As SHELLEXECUTEINFOA) As Long
Private Type SHELLEXECUTEINFOA
  cbSize As Long
  fMask As Long
  hWnd As Long
  lpVerb As String
  lpFile As String
  lpParameters As String
  lpDirectory As String
  nShow As Long
  hInstApp As Long
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type

Private Declare Function ShellExecuteExW Lib "shell32" (ShellExInfo As SHELLEXECUTEINFOW) As Long
Private Type SHELLEXECUTEINFOW
  cbSize As Long
  fMask As Long
  hWnd As Long
  lpVerb As Long
  lpFile As Long
  lpParameters As Long
  lpDirectory As Long
  nShow As Long
  hInstApp As Long
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type



Public Sub file_properties(ByVal fName As String)
  Dim ShExInfo As SHELLEXECUTEINFOW         ' Unicode structure

  #If ANSISupport Then                      ' support of ANSI and Unicode
    If isUnicode Then                       ' UNICODE version
      With ShExInfo                         ' fill structure with values...
        .cbSize = Len(ShExInfo)
        .fMask = &H54C
        .hWnd = 0
        .lpVerb = StrPtr("properties")
        .lpFile = StrPtr(fName & Chr$(0))
      End With
      ShellExecuteExW ShExInfo              ' Unicode API call
    Else                                    ' ANSI Version
      Dim ShExInfoA As SHELLEXECUTEINFOA    ' ANSI structure
      With ShExInfoA                        ' fill structure with values...
        .cbSize = Len(ShExInfoA)
        .fMask = &H54C
        .hWnd = 0
        .lpVerb = "properties"
        .lpFile = fName & Chr$(0)
      End With
      ShellExecuteExA ShExInfoA             ' ANSI API call
    End If
  #Else                                     ' support UNICODE ONLY (small and fast code!)
    With ShExInfo                           ' fill structure with values...
      .cbSize = Len(ShExInfo)
      .fMask = &H54C
      .hWnd = 0
      .lpVerb = StrPtr("properties")
      .lpFile = StrPtr(fName & Chr$(0))
    End With
    ShellExecuteExW ShExInfo                ' Unicode API call
  #End If
End Sub


 

Autor: Ralf Schlegel
Stand: 12/2012

Nach oben

0006 CopyFile - eine einzelne Datei kopieren

Die API Funktion CopyFile dient zum Kopieren einer einzelnen Datei und ist schnelle als die VBA interne Function CopyFile.
Da man mit ihr nur eine einzelne Datei kopieren kann, ist sie kein echter Ersatz für das VBA Pendant, hat aber andere Vorteile:

Der folgende Codeabschnitt zeigt die API-Funktion, die neben Unicode auch UNC-Path unterstützt! Der übergebene Dateiname ist außerdem nicht mehr auf MAX_PATH (256-Zeichen) beschränkt und ''\\Servername\Verzeichnis1\MeineDatei.dat'' kann auch als Dateiname übergeben werden.

  • Beachten Sie die Vorbedingungen
  • Diese Funktion ist Bestandteil des Moduls vbzGlobal.bas, das sie hier kostenlos herunterladen können.

 

#If ANSISupport Then
  Private Declare Function CopyFileA Lib "kernel32" (ByVal lpExistingFileName As String, _
          ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
#End If
Private Declare Function CopyFileW Lib "kernel32" (ByVal lpExistingFileName As Long, _
        ByVal lpNewFileName As Long, ByVal bFailIfExists As Long) As Long


' Copy a single file from source to destination; overwrites destination, if it already exists
' If unicode is available 'FileNames' support UNC path and file name lenght up to 23768 chars!
Public Function CopyFile(ByVal srcFileName As String, ByVal dstFileName As String) As Long
  #If ANSISupport Then
    If isUnicode Then
      CopyFile = CopyFileA(srcFileName, dstFileName, 0&)
    Else
      If Left$(srcFileName, 2) = "\\" Then srcFileName = "UNC\" & Mid$(srcFileName, 3)
      If Left$(dstFileName, 2) = "\\" Then dstFileName = "UNC\" & Mid$(dstFileName, 3)
      CopyFile = CopyFileW(StrPtr("\\?\" & srcFileName), StrPtr("\\?\" & dstFileName), 0&)
    End If
  #Else
    If Left$(srcFileName, 2) = "\\" Then srcFileName = "UNC\" & Mid$(srcFileName, 3)
    If Left$(dstFileName, 2) = "\\" Then dstFileName = "UNC\" & Mid$(dstFileName, 3)
    CopyFile = CopyFileW(StrPtr("\\?\" & srcFileName), StrPtr("\\?\" & dstFileName), 0&)
  #End If
End Function


 

Autor: Ralf Schlegel
Stand: 04/2015

Nach oben