Warum auch immer: die VBA Funktionen GetAttr und SetAttr scheinen spätestens ab Windows Vista hin und wieder Probleme zu bereiten. Erst recht, wenn sie im Batch (mehrer Dateien hintereinander) benutzt werden. Ausserdem 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 zusätzlich noch UNICODE und UNC-Path unterstützt! D.h.: der übergebene Dateiname ist nicht mehr auf MAX_PATH (256-Zeichen) beschränkt und '\\Servername\Verzeichnis1\MeineDatei.dat' kann auch als Dateiname übergeben werden. Kopieren Sie den nachfolgenden Code in ein beliebiges Projektmodul.<(ü> Das war's dann auch schon, da die Public Funktionsnamen und Parameter in diesem Code mit denen des VBA identisch sind, werden die alten VBA-Funktionen praktisch überschrieben bzw. ignoriert und Sie müssen an Ihrem vorhandenen Projekt keinerlei weiter Änderungen vornehmen! - Das Leben kann so einfach sein... Option Explicit 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 Declare Function SetFileAttributesA Lib "kernel32" ( _ ByVal lpFileName As String, _ ByVal dwFileAttributes As Long) As Long Private Declare Function SetFileAttributesW Lib "kernel32" ( _ ByVal lpFileName As Long, _ ByVal dwFileAttributes As Long) As Long Private Declare Function GetVersionEx Lib "kernel32" _ Alias "GetVersionExA" ( _ lpVersionInformation As OSVERSIONINFO) As Long ' Typendefinition Betriebssystem 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_WIN32s = 0 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32_NT = 2 Public Enum vbzFileAttrib FILE_ATTRIBUTE_READONLY = &H1 FILE_ATTRIBUTE_HIDDEN = &H2 FILE_ATTRIBUTE_SYSTEM = &H4 FILE_ATTRIBUTE_VOLUME = &H8 ' Readonly Attribut! Nicht in SetAttr verwenden! 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 #If False Then Const FILE_ATTRIBUTE_READONLY = &H1 Const FILE_ATTRIBUTE_HIDDEN = &H2 Const FILE_ATTRIBUTE_SYSTEM = &H4 Const FILE_ATTRIBUTE_VOLUME = &H8 Const FILE_ATTRIBUTE_DIRECTORY = &H10 Const FILE_ATTRIBUTE_ARCHIVE = &H20 Const FILE_ATTRIBUTE_ALIAS = &H40 Const FILE_ATTRIBUTE_NORMAL = &H80 Const FILE_ATTRIBUTE_TEMPORARY = &H100 Const FILE_ATTRIBUTE_REPARSE_POINT = &H400 Const FILE_ATTRIBUTE_COMPRESSED = &H800 Const FILE_ATTRIBUTE_OFFLINE = &H1000 Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000 Const FILE_ATTRIBUTE_ENCRYPTED = &H4000 #End If Private Function isUnicode() As Boolean ' Prüft auf NT (Unicode)-Betriebssysteme: ' True bei NT/2000/XP/Vista/Win7, sonst False Dim info As OSVERSIONINFO info.dwOSVersionInfoSize = Len(info) GetVersionEx info isUnicode = (info.dwPlatformId = VER_PLATFORM_WIN32_NT) End Function Public Function GetAttr(ByVal fName As String) As vbzFileAttrib If isUnicode Then If Left$(fName, 2) = "\\" Then fName = "UNC\" & Mid$(fName, 3) GetAttr = GetFileAttributesW(StrPtr("\\?\" & fName)) Else GetAttr = GetFileAttributesA(fName) End If End Function Public Function SetAttr(ByVal fName As String, _ ByVal Attributes As vbzFileAttrib) As Boolean 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 End Function P.S.: die "isUnicode" Abfrage können Sie getrost entfernen, wenn Ihre Applikation ohnehin nur für Win2K und neuer gedacht ist! Dieser Tipp wurde bereits 11.039 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |