Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim WShell As Object
Dim sFavPath As String
Dim fso As Object
Dim oFavFolder As Object
Dim file As Object
Dim r As Integer
Private Sub TreeView1_Click()
Dim ts As INode
Dim strURL As Object
Set ts = TreeView1.SelectedItem
'指定捷徑
Set strURL = WShell.CreateShortcut(sFavPath & "\" & Replace(ts.FullPath, "我的最愛", "") & ".url")
If strURL.TargetPath <> "" Then
WebBrowser1.Navigate "" & strURL.TargetPath '捷徑的目標路徑
End If
End Sub
Private Sub UserForm_Initialize()
Dim nd As Node '宣告節點變數
'初始化ImageList1控件
ListFaceIdImage
' 建立根節點
Set nd = TreeView1.Nodes.Add(, , , "我的最愛", 1)
nd.Expanded = True
Set WShell = CreateObject("wscript.Shell")
' 取得我的最愛路徑
sFavPath = WShell.specialfolders("favorites")
'建立一個 FileSystemObject 物件
Set fso = CreateObject("scripting.filesystemobject")
'指定我的最愛資料夾 Folder 物件
Set oFavFolder = fso.getfolder(sFavPath)
'建立 TreeView 節點
Call ListFavFolder(nd.Index, oFavFolder)
For Each file In oFavFolder.Files '指定資料夾中所有 Files 集合物件
If LCase(Right(file.Name, 4)) = ".url" Then
TreeView1.Nodes.Add nd.Index, tvwChild, , LCase(Left(file.Name, Len(file.Name) - 4)), 4
End If
Next file
End Sub
Sub ListFavFolder(idx, argFolder)
Dim folder As Object
Dim nd1 As Node
For Each folder In argFolder.subfolders '指定資料夾內所有 Folder 集合物件
Set nd1 = TreeView1.Nodes.Add(idx, tvwChild, , folder.Name, 2, 3)
For Each file In folder.Files ''指定資料夾中所有 Files 集合物件
If LCase(Right(file.Name, 4)) = ".url" Then
'建立節點
TreeView1.Nodes.Add nd1.Index, tvwChild, , LCase(Left(file.Name, Len(file.Name) - 4)), 4
End If
Next file
Call ListFavFolder(nd1.Index, folder)
Next folder
End Sub
Sub ListFaceIdImage()
'將指定的內建Facid小圖示導入ImageList控件中
Dim i As Integer
Dim NewToolbar As CommandBar
Dim NewButton As CommandBarButton
Dim FaceIDNumbers As Variant
Dim picPicture As IPictureDisp
Dim iImageName As ListImage
FaceIDNumbers = Array(733, 598, 599, 2174, 1741)
On Error Resume Next
Application.CommandBars("FaceIds").Delete
On Error GoTo 0
Set NewToolbar = Application.CommandBars.Add(Name:="FaceIds", temporary:=True)
NewToolbar.Visible = False
For i = 0 To 4
Set NewButton = NewToolbar.Controls.Add(Type:=msoControlButton, ID:=2950)
NewButton.FaceId = FaceIDNumbers(i)
Set picPicture = Nothing
Set picPicture = NewButton.Picture
Set iImageName = Me.ImageList1.ListImages.Add(, , picPicture)
NewButton.Delete
Next
On Error Resume Next
Application.CommandBars("FaceIds").Delete
On Error GoTo 0
With Me.TreeView1
.ImageList = Me.ImageList1
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.CommandBars("FaceIds").Delete
On Error GoTo 0
End Sub
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2004-7-21 15:52
