'在模块输入以下代码。
Public Declare Function GetPrivateProfileString Lib "kernel32" _
   Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String, _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As LongPublic Function ReadString(ByVal Section As String, ByVal key As String, filepath As String) As String
On Err GoTo err1
    Dim X As Long, buff As String * 300, i As Integer
    X = GetPrivateProfileString(Section, key, "", buff, 300, filepath)
    i = InStr(buff, Chr(0))
    ReadString = Trim(Left(buff, i - 1))
err1:
    Exit Function
End Function
Public Sub geturl(folderpath As String)
On Error GoTo err1
Dim f, f1, f2, fc, S, nextfolder, f3, files
Dim fs As Object, file
Dim a As Long
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderpath)
    Set fc = f.SubFolders
    Set files = f.files
    For Each file In files
    If Right(file.Name, 3) = "url" Then
    If Dir(apppath("url.txt")) <> "" Then
    Kill apppath("url.txt")
    End If
a = Form1.ListView1.ListItems.count + 1
FileCopy file.path, apppath(file.Name + ".txt")
Form1.Inet1.URL = ReadString("InternetShortcut", "URL", apppath(file.Name + ".txt"))
Form1.ListView1.ListItems.Add a, , file.Name
Form1.ListView1.ListItems(a).SubItems(1) = ReadString("InternetShortcut", "URL", apppath(file.Name + ".txt"))
 
Kill apppath(file.Name + ".txt")
    End If
    Next
    For Each f1 In fc
    If f1 <> "" Then
    If Right(folderpath, 1) = "\" Then
    geturl folderpath + f1.Name
    Else
    geturl folderpath + "\" + f1.Name
    End If
    End If
    Next
err1:
Resume Next
End Sub
使用方法
geturl(收藏夹的路径)