Asociace ikony k adresáři

Postup:

Private Declare Function SetFileAttributes Lib "kernel32" Alias _
    "SetFileAttributesA" (ByVal lpFileName As String, _
    ByVal dwFileAttributes As Long) As Long

' Parametry:
'   sFolderPath: cesta k adresáři, ke kterému přiřadíte ikonu
'   sIconFile: ikona k asociaci. Může to být .ico, .exe nebo .dll soubor
'   iIconIndex: index ikony pokud soubor jich obsahuje více 
'
' Příklad:
'   SetFolderIcon "C:\NiceFolder", "C:\Documents\TestIcon.ico"

Sub SetFolderIcon(ByVal sFolderPath As String, ByVal sIconFile As String, _
    Optional ByVal iIconIndex As Long = 0)
    Dim sContent As String
    Dim sDesktopFile As String
    Dim bExists As Boolean
    Dim handle As Integer
    
    On Error Resume Next
    ' Test existence souboru i adresáře
    bExists = (GetAttr(sFolderPath) And vbDirectory) <> 0 And (GetAttr _
        (sIconFile) And vbDirectory) = 0
    If bExists = False Or Err.Number <> 0 Then Exit Sub
    
    ' Tvorba obsahu souboru
    sContent = "[.ShellClassInfo]" & vbCrLf & "IconIndex=" & iIconIndex & _
        vbCrLf & "IconFile=" & sIconFile
    
    'tvorba cesty k souboru desktop.ini 
    sDesktopFile = sFolderPath & IIf(Right$(sFolderPath, 1) = "\", "", _
        "\") & "desktop.ini"
    
    ' Otevření souboru a zapsání obsahu
    handle = FreeFile
    Open sDesktopFile For Output As #handle
    Print #handle, sContent;
    Close #handle
    
    ' Skrytí souboru a adresář jen Read-Only
    SetFileAttributes sDesktopFile, vbHidden
    SetFileAttributes sFolderPath, vbReadOnly
    
End Sub

Zpět

Autor: The Bozena