Private 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
  
Private Const MAX_PATH As Long = 260
 
'File Operations
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

'File Operation Flags
Private Const FOF_MULTIDESTFILES As Long = &H1
Private Const FOF_CONFIRMMOUSE As Long = &H2
Private Const FOF_SILENT As Long = &H4              'don't create progress/report
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10     'don't prompt the user.
Private Const FOF_WANTMAPPINGHANDLE As Long = &H20  'Fill in SHFILEOPSTRUCT.hNameMappings
                                                    'Must be freed using SHFreeNameMappings
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_FILESONLY As Long = &H80          'on *.*, do only files
Private Const FOF_SIMPLEPROGRESS As Long = &H100    'don't show names of files
Private Const FOF_NOCONFIRMMKDIR As Long = &H200    'don't confirm making any needed dirs
Private Const FOF_NOERRORUI As Long = &H400         'don't put up error UI
Private Const FOF_NORECURSION As Long = &H1000      'don't recurse into directories
Private Const FOF_NOCOPYSECURITYATTRIBS As Long = &H800  'don't copy NT file Security Attributes
Private Const FOF_NO_CONNECTED_ELEMENTS As Long = &H2000 'Shell v5+: don't operate on connected file elements
Private Const FOF_WANTNUKEWARNING As Long = &H4000       'Shell v5+: during delete operation, warn if
                                                         'nuking instead of recycling (partially
                                                         'overrides FOF_NOCONFIRMATION)
Private Const FOF_NORECURSEREPARSE As Long = &H8000&  'Shell v5.1+: treat reparse points as
                                                      'objects, not containers
                                                   
Private Declare Function GetTempPath Lib "kernel32" _
     Alias "GetTempPathA" _
    (ByVal nSize As Long, _
     ByVal lpBuffer As String) As Long

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

'FO_FUNC is determined by the 
'type of SHFileOperation action chosen 
'(move/delete/rename/copy)  
Private FO_FUNC As Long
  
'FOF_FLAGS is determined by the
'both the SHFileOperation Actions/Method 
'frame and the SHFileOperation Options 
'frame choices (delete/recycle/simple 
'progress/no confirm etc.)  
Private FOF_FLAGS As Long
 
'for ease of reading, substitute constants 
'for numbers in code SHFileOperationAction 
'option button constants
Private Const FileMove As Long = 1
Private Const FileCopy As Long = 2
Private Const FileDelete As Long = 3


Private Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

   Option1(0).Caption = "to the Recycle Bin"
   Option1(0).Value = True
   Option1(1).Caption = "permanently"
   Option2(FileMove).Caption = "Move files to temp folder"
   Option2(FileCopy).Caption = "Copy files to temp folder"
   Option2(FileDelete).Caption = "Delete ..."
   Option2(FileDelete).Value = True
      
   Check1.Caption = "Don't show operation (silent)"
   Check2.Caption = "Don't show filenames for multiple deletes"
   Check3.Caption = "Don't prompt for confirmation"
   
   Command1.Caption = "Perform Action"
   File1.Pattern = "*.txt"
     
End Sub


Private Sub Command1_Click()
 
  'set some working variables  
   Dim cnt As Long
   Dim c As Long
   Dim fNames() As String
   Dim fPath As String
   Dim r As Long
   Dim target As String
 
  'get the current path from the Dir1 control  
   fPath = Dir1.Path
 
  'load an array with the file names selected  
   For cnt = 0 To File1.ListCount - 1
    
      If File1.Selected(cnt) Then
       
         c = c + 1
         ReDim Preserve fNames(1 To c)
         fNames(c) = fPath & "\" & File1.List(cnt)
      
      End If
  
   Next
 
  'if nothing is yet selected, 
  'don't go any farther  
   If c = 0 Then Exit Sub
 
  'if copying or moving to the temp 
  'folder, get its location  
   If Option2(1).Value Or _
      Option2(2).Value Then target = GetTempDir()
 
  'call ShellDelete  
   Call ShellDelete(fNames(), target)
 
  'refresh the file list  
   File1.Refresh
  
End Sub


Private Sub Dir1_Change()

   File1.Path = Dir1.Path

End Sub


Private Sub Option2_Click(Index As Integer)
 
  'this was missing from previous 
  'posts. Thanks to Sylvain Hamel 
  'for noticing!
   FO_FUNC = CLng(Index)
 
  'disable the Method frame 
  'if the action <> delete
   frDeleteMethod.Enabled = Option2(FileDelete).Value = True

End Sub


Private Function GetOptionFlags() As Long
 
  'Iterate through the options, 
  'and build the flag variable
  'according to the user selection.  
 
  'can only have one of these, so ..  
   If Option1(0).Value Then GetOptionFlags= FOF_ALLOWUNDO
 
  'these can be multiple  
   If Check1.Value Then GetOptionFlags = GetOptionFlags Or FOF_SILENT
   If Check2.Value Then GetOptionFlags = GetOptionFlags Or FOF_SIMPLEPROGRESS
   If Check3.Value Then GetOptionFlags = GetOptionFlags Or FOF_NOCONFIRMATION

End Function


Private Function GetTempDir() As String

   Dim nSize As Long
   Dim tmp As String
    
   tmp = Space$(MAX_PATH)
   nSize = Len(tmp)
   Call GetTempPath(nSize, tmp)
    
   GetTempDir = TrimNull(tmp)
    
End Function


Private Function TrimNull(item As String)

   Dim pos As Long
   
  'double check that there is a 
  'vbNullChar (Chr$(0)) in the string  
   pos = InStr(item, vbNullChar)
   If pos Then
      TrimNull = Left$(item, pos - 1)
   Else
      TrimNull = item
   End If
  
End Function


Private Sub ShellDelete(sFileArray() As String, sDestination As String) 
 
  'Note: sDestination (the pTo member of 
  'the SHFILEOPSTRUCT) is ignored for deletion.
  '
  'In addition, a DWORD-alignment problem exists 
  'in the shf Type. This means you can not 
  'use the shf hNameMaps or sProgress 
  'members without significant code changes to 
  'assure DWORD alignment is corrected. See the 
  'MS KB for information. If you attempt to use 
  'these members without following the 
  'instructions in the KB and cause a GPF, 
  'this alignment issue is probably the cause.
 
  'working variables
   Dim cnt As Long
   Dim sFiles As String
   Dim shf As SHFILEOPSTRUCT
 
  'create a single string of files from the 
  'passed file array, each separated by nulls  
   For cnt = LBound(sFileArray) To UBound(sFileArray)
      sFiles = sFiles & sFileArray(cnt) & vbNullChar
   Next

  'add a final null to double-null 
  'terminate the string
   sFiles = sFiles & vbNullChar

  'determine the user's options selected  
   FOF_FLAGS = GetOptionFlags()
 
  'set up the options  
   With shf
     .wFunc = FO_FUNC    'action to take place
     .pFrom = sFiles     'the files to act on
     .pTo = sDestination 'the destination, if not recycle
     .fFlags = FOF_FLAGS 'special flags (FOF_*)
   End With
 
  'and perform the chosen operation  
   Call SHFileOperation(shf)

End Sub