例子代码：添加项目到收藏夹

'代码   Module1.bas   
  Option   Explicit   
    
  Public   Declare   Function   SHGetPathFromIDList   Lib   "shell32.dll"   Alias   "SHGetPathFromIDListA"   (ByVal   pidl   As   Long,   ByVal   pszPath   As   String)   As   Long   
  Public   Declare   Function   SHGetSpecialFolderLocation   Lib   "shell32.dll"   (ByVal   hwndOwner   As   Long,   ByVal   nFolder   As   Long,   pidl   As   Long)   As   Long   
  Public   Const   CSIDL_FAVORITES   =   &H6   
    
  Public   Function   GetSpecialPath(lHandle   As   Long,   CSIDL   As   Long)   As   String   
  On   Error   GoTo   ErrorHandle   
  Dim   lReturn   As   Long   
  Dim   sPath   As   String   
  Dim   lPIDL   As   Long   
  lReturn   =   SHGetSpecialFolderLocation(lHandle,   CSIDL,   lPIDL)   
  If   lReturn   =   0   Then   
      sPath   =   Space$(512)   
      lReturn   =   SHGetPathFromIDList(ByVal   lPIDL,   ByVal   sPath)   
      GetSpecialPath   =   Left$(sPath,   InStr(sPath,   Chr$(0))   -   1)   
      Exit   Function   
  End   If   
  ErrorHandle:   
      GetSpecialPath   =   ""   
      On   Error   GoTo   0   
  End   Function   
    
  Public   Sub   SendToFav(sName   As   String,   sURL   As   String,   lSender   As   Long)   
  Dim   sFav   As   String   
  Dim   iFreeFile   As   Integer   
  sFav   =   GetSpecialPath(lSender,   CSIDL_FAVORITES)   
  If   sFav   <>   ""   Then   
      iFreeFile   =   FreeFile   
      Open   sFav   &   ""   &   sName   &   ".URL"   For   Output   As   #iFreeFile   
          Print   #iFreeFile,   "[InternetShortcut]"   &   vbCrLf   
          Print   #iFreeFile,   "URL="   &   sURL   
      Close   #iFreeFile   
  Else   
      Err.Raise   9999,   ,   "无法获取收藏夹目录"   
  End   If   
  End   Sub   
    
  '应用   
  'Form1.frm   
  '添加两个正文框和一个命令按纽   
  Option   Explicit   
    
  Private   Sub   Command1_Click()   
  On   Error   GoTo   ErrorHandle   
  SendToFav   Text1,   Text2,   hWnd   
  ErrorHandle:   
      If   Err   <>   0   Then   MsgBox   Err.Description,   vbCritical   
  End   Sub