Public Type SHFILEOPSTRUCT
   hWnd        As Long
   wFunc       As Long
   pFrom       As String
   pTo         As String
   fFlags      As Integer
   fAborted    As Boolean
   hNameMaps   As Long
   sProgress   As String
 End Type
  
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4

Public Const FOF_SILENT = &H4
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_FILESONLY = &H80
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_NOCONFIRMMKDIR = &H200

Public Const SHARD_PATH = &H2& 

Public Declare Function SHAddToRecentDocs Lib "shell32" _
  (ByVal dwFlags As Long, _
   ByVal dwData As String) As Long

Public Declare Function SHFileOperation Lib "shell32" _
   Alias "SHFileOperationA" _
  (lpFileOp As SHFILEOPSTRUCT) As Long

Public Declare Function SHGetPathFromIDList Lib "shell32" _
   Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
   ByVal pszPath As String) As Long
       
Public Declare Function SHGetSpecialFolderLocation Lib "shell32" _
  (ByVal hwndOwner As Long, _
   ByVal nFolder As Long, _
     pidl As Long) As Long

Option Explicit

Private Sub Command1_Click()

   Dim i As Integer
   Dim FolderPath As String
   Dim StartMenuPath As String
   Dim fNameOld As String
   Dim fNameNew As String
   Dim fNames() As String
   ReDim fNames(1 To 3) As String
   Const CSIDL_RECENT = &H8
   Const CSIDL_STARTMENU = &HB

  
  'Lets do some preparation before actually
  'doing any disk activities.
  'We'll need 2 things....
  '--------------------------------------------------------------------
  '- The path to the user's start menu folder.  This is
  '  needed because different users may use different
  '  paths for the current menu (i.e. on my Win95 system,
  '  my Windows folder is c:\win); Win NT4 uses profiles
  '  so each user has their own. Therefore, call the
  '  SHGetSpecialFolderLocation which is encapsulated
  '  in the GetRecentFolders() function.
  '- We also need the user's Start Menu folder, for the
  '  same reasons.  
   FolderPath = GetSpecialFolder(CSIDL_RECENT)
   StartMenuPath = GetSpecialFolder(CSIDL_STARTMENU)
   
   If FolderPath = "" Or StartMenuPath = "" Then
      MsgBox "We canne' do it Captain: Error retrieving folder paths."
      Exit Sub
   End If
  
  'for debugging - print the resulting strings  
   Print FolderPath
   Print StartMenuPath
  
  'set up the StartMenuPath now to reflect the folder
  'we'll be installing the shortcuts into a bit later  
   StartMenuPath = StartMenuPath & "Programs\MyApp\"
  
  '--------------------------------------------------------------------
  'These are the three fictional files to create shortcuts
  'for. They represent typical files you might
  'provide with your app. To make things even more
  'complicated, point to a drive that doesn't host Windows.
  'Note that SHAddToRecentDocs doesn't care if the file actually 
  'exists at this point; it is not resolved until the shortcut 
  'is accessed.  
   fNames(1) = "d:\MyApp\Thunder.exe"
   fNames(2) = "d:\MyApp\Thunder Help.hlp"
   fNames(3) = "d:\MyApp\Thunder Readme.txt"
  
  '--------------------------------------------------------------------
  'The first step is to get these files added to the
  'Recent Files list.  The SHAddToRecentDocs API
  'makes this a simple task.  
   Call SHAddToRecentDocs(SHARD_PATH, fNames(1))
   Call SHAddToRecentDocs(SHARD_PATH, fNames(2))
   Call SHAddToRecentDocs(SHARD_PATH, fNames(3))
  
  'At this point, if you check the Start\Documents menu, 
  'the 3 files above will be listed.

  '--------------------------------------------------------------------
  'Since we now know the shortcuts exist in the documents
  'folder, and the path to both that folder and the users
  'start menu, we can move the shortcuts from the recent
  'folder into our new application folder using the
  'SHFileOperation API.  Conveniently, SHFileOperation
  'will even create out new folder for us if it doesn't
  'exist!  And by specifying the flags FOF_SILENT and
  'FOF_NOCONFIRMATION, messages and dialogs indicating
  'this is happening will be suppressed.
  '
  'Because the shortcuts now reside in the Recent folder,
  'we need to modify the file array to include the Recent
  'folder path. In addition, the extension now has .lnk 
  'appended to the original filename.  
   fNames(1) = FolderPath & "Thunder.exe.lnk"
   fNames(2) = FolderPath & "Thunder Help.hlp.lnk"
   fNames(3) = FolderPath & "Thunder Readme.txt.lnk"
  
  'for debugging - do a DIR against the shortcuts
  'to confirm they do exist  
   For i = 1 To 3
      Print Dir(fNames(i))
   Next
  
  'call SHFileOperation to move the shortcuts  
   ShellMoveFiles fNames(), StartMenuPath
  
'--------------------------------------------------------------------
  'Now, if desired, we can rename the links to
  'something more traditional for a start menu item.
  'The FO_RENAME flag in ShellRenameFile requires
  'that we do this one file at a time.  
   fNameOld = StartMenuPath & "Thunder.exe.lnk"
   fNameNew = StartMenuPath & "Whoh! Baby! Thunder.lnk"
   ShellRenameFile fNameOld, fNameNew
   
   fNameOld = StartMenuPath & "Thunder Help.hlp.lnk"
   fNameNew = StartMenuPath & "MyApp Thunder Help.lnk"
   ShellRenameFile fNameOld, fNameNew
   
   fNameOld = StartMenuPath & "Thunder Readme.txt.lnk"
   fNameNew = StartMenuPath & "MyApp Readme.lnk"
   ShellRenameFile fNameOld, fNameNew
  
End Sub


Private Sub ShellMoveFiles(sFileArray() As String, sDestination As String)
  
  'set working variables  
   Dim i As Integer
   Dim sFiles As String
   Dim SHFileOp As SHFILEOPSTRUCT
  
  'create a single string of files from the passed file array,
  'each separated by Chr$(0)  
   For i = LBound(sFileArray) To UBound(sFileArray)
      sFiles = sFiles & sFileArray(i) & Chr$(0)
   Next
  
  'add a final terminating null  
   sFiles = sFiles & Chr$(0)
  
  'for debugging - print the resulting strings  
   Print sFiles
  
  'set up the options  
   With SHFileOp
      .wFunc = FO_MOVE
      .pFrom = sFiles
      .pTo = sDestination
      .fFlags = FOF_SILENT Or FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR
   End With
  
  'and perform the move.  Because the folder specified 
  'doesn't exist, SHFileOperation will create it. FOF_SILENT 
  'above instructs the API to suppress displaying the "flying 
  'folders" dialog during the move.  FOF_NOCONFIRMATION suppresses 
  'prompting to move the files ... the "Are you sure you want to
  'move etc..." dialog. FOF_NOCONFIRMMKDIR instructs it to 
  'create the folder without prompting if it is OK.
   Call SHFileOperation(SHFileOp)

End Sub


Private Function GetSpecialFolder(CSIDL As Long) As String
  
  'a few local variables needed  
   Dim sPath As String
   Dim pidl As Long
   
   Const ERROR_SUCCESS = 0
   Const MAX_LENGTH = 260
  
  'fill pidl with the specified folder item   
   If SHGetSpecialFolderLocation(Me.hWnd, CSIDL, pidl)= ERROR_SUCCESS Then
     
     'Of the structure is filled, initialize and
     'retrieve the path from the id list, and return
     'the folder with a trailing slash appended.  
      sPath = Space$(MAX_LENGTH)
       
      If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
         GetSpecialFolder = Left$(sPath, _
                            InStr(sPath, Chr$(0)) - 1) & "\"
      End If
      
   End If

End Function


Private Sub ShellRenameFile(sOldName As String, sNewName As String)
  
  'set working variables  
   Dim SHFileOp As SHFILEOPSTRUCT
  
  'add a pair of terminating nulls to each string  
   sOldName = sOldName & Chr$(0) & Chr$(0)
   sNewName = sNewName & Chr$(0) & Chr$(0)
  
  'for debugging - print the resulting strings  
   Print sOldName
   Print sNewName
  
  'set up the options  
   With SHFileOp
      .wFunc = FO_RENAME
      .pFrom = sOldName
      .pTo = sNewName
      .fFlags = FOF_SILENT Or FOF_NOCONFIRMATION
   End With
  
  'and rename the file  
   Call SHFileOperation(SHFileOp)

End Sub