Change Folders icon using VBA

Option Explicit

Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000

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

Private Function SetAttri(ByVal lpFile As String, ByVal Flags As Long) As Boolean
    SetAttri = SetFileAttributes(lpFile, Flags)
End Function

Sub FolderIconizer()
 
    Dim varFolder
    Dim varPicture
    Dim strPicName As String
    
    'Get the name of the image file
    varPicture = Application.GetOpenFilename("Bitmap or Icon Files,*.bmp;*.ico")
    'If user cancelled, then exit the procedure
    If varPicture = False Then Exit Sub
    
    strPicName = Right(varPicture, Len(varPicture) - InStrRev(varPicture, "\"))
    strPicName = Left(varPicture, Len(varPicture) - Len(strPicName)) & "Folder.ico"
    
    'Get the name of the folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        'Since we are just looking for 1 folder, multiple selection cannot be allowed
        .AllowMultiSelect = False
        .Show 'Show the dialog box
        If .SelectedItems.Count Then '(Greater than 0 = True, 0 = False)
            varFolder = .SelectedItems(1)
        Else
            'If no item is selected, then exit the procedure
            Exit Sub
        End If
    End With
    
    On Error Resume Next
    
    If Not varPicture = varFolder & "\Folder.ico" Then 'You can't use the same folder wherein the image file is
        SetAttr varFolder & "\Folder.ico", vbNormal 'Set the property of the folder.ico file to normal
        SetAttr varFolder & "\Desktop.ini", vbNormal 'Set the property of the Desktop.ini file to normal
        SetAttr varFolder & "\Thumb.db", vbNormal 'Set the property of the Thumb.db file to normal
        Kill varFolder & "\Folder.ico" 'Remove the folder.ico file if it exits
        Kill varFolder & "\Desktop.ini" 'Remove the Desktop.ini file if it exits
        Kill varFolder & "\Thumb.db" 'Remove the Thumb.db file if it exits
    End If
    Err.Clear: On Error GoTo -1: On Error GoTo -1
    SetAttr varFolder & "\", vbSystem 'Reset the system attribute of the folder to take effect in case we had changed any of the attributes
    FileCopy varPicture, varFolder & "\Folder.ico" 'Copy the image file to the folder giving it a name as folder.ico (For standardization purposes)
    Open varFolder & "\Desktop.ini" For Output As #1 'Write the required lines within the Desktop.ini file
    Print #1, "[.ShellClassInfo]" & vbNewLine _
                & "ConfirmFileOp = 1" & vbNewLine _
                & "InfoTip=Global Monitor" & vbNewLine _
                & "OriginalIcon=%" & vbNewLine _
                & "IconFile = Folder.ico" & vbNewLine _
                & "IconIndex = 0"
    Close #1
    SetAttr varFolder & "\Folder.ico", vbHidden 'Set the property of the folder.ico file to hidden
    SetAttr varFolder & "\Desktop.ini", vbHidden 'Set the property of the Desktop.ini file to hidden
    SetAttr varFolder & "\", vbSystem 'Reset the system attribute of the folder to take effect
     
    
End Sub