自定义指定文件夹的图标

编程思路：按一定格式在文件夹中建立Desktop.ini文件并将文件夹的属性设置为系统属性即可自定义文件夹的图标。文件的建立不难，关键是更改文件夹属性，得用上VB的内部函数Attributes来实现。

Desktop.ini文件格式：
[.ShellClassInfo]
IconIndex=0
iconfile=Icon图标所在的驱动器我 路径名 文件名

下面是完整的程序代码。使用前请给工程添加一个按钮、一个公共对话框、一个DriveListBox和一个DirListBox。

Option Explicit

Dim sPath As String '文件夹变量

Private Sub Dir1_Click()
Dim i As Integer
Command1.Enabled = True
i = Dir1.ListIndex
sPath = Dir1.List(i)
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Load()
Command1.Caption = "定义文件夹图标"
Command1.Enabled = False
End Sub

Private Sub Command1_Click()
ChangeFolderInfo sPath '更改目录为系统文件

Dim s As String '图标文件路径、名称变量
With CommonDialog1
.Filter = "(*.ico)|*.ico"
.DialogTitle = "查找图标"
.ShowOpen
s = .FileName
End With

Open sPath "\" "desktop.ini" For Output As #1
Print #1, "[.ShellClassInfo]" vbCrLf "IconIndex=0" vbCrLf "iconfile=" s
Close #1

ChangeFileInfo (sPath "\" "desktop.ini")
End Sub

'赋予文件夹系统属性子程序
Private Sub ChangeFolderInfo(folderspec)
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
f.Attributes = 4 '用Attributes函数设置文件夹属性
End Sub

'赋予Desktop.ini文件隐藏属性
Private Sub ChangeFileInfo(filespec)
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
f.Attributes = 2 '用Attributes属性设置文件属性
End Sub

运行程序，打开"我的电脑"找到更改了图标的文件夹看看，效果如何？