Hi,
I have been trying to change the icon of all sub folders (actually categorized depending on subject) of a main folder using excel vba. This shall help to make it possible to change the icon in one go, without consuming much time.
Data Available:
For this, i have an excel sheet, in which:
1. Column A, has got the path of all folders.
2. Column B, is with path names of all *.ico files.
What i am looking for:
1. Assign the icon to each folder having the path in column A, having the path of *.ico file in column B.
2. To symbolize this, a column C should have the image of the icon file.
This is am seeking for the Folder list of around 500, so that is required to have more categorization apart from their names, which shall assist in recognizing it.
One code, which gets me along by selecting one folder and one *.ico file at a time, is given for the reference.
Request for the assistance, which shall save hours of work.
Anticipatory Thanks!
I have been trying to change the icon of all sub folders (actually categorized depending on subject) of a main folder using excel vba. This shall help to make it possible to change the icon in one go, without consuming much time.
Data Available:
For this, i have an excel sheet, in which:
1. Column A, has got the path of all folders.
2. Column B, is with path names of all *.ico files.
What i am looking for:
1. Assign the icon to each folder having the path in column A, having the path of *.ico file in column B.
2. To symbolize this, a column C should have the image of the icon file.
This is am seeking for the Folder list of around 500, so that is required to have more categorization apart from their names, which shall assist in recognizing it.
One code, which gets me along by selecting one folder and one *.ico file at a time, is given for the reference.
Code:
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
Request for the assistance, which shall save hours of work.
Anticipatory Thanks!