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.015 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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. sevOutBar 4.0 Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
||||||||||||||||
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. |