Snasui Excel Forum

Code: Select all

Sub DeleteFiles()
  Dim Path As String
  Path = "C:\Users\One\Desktop\Test\"
  Shell Environ("comspec") & " /c DEL /Q " & """" & Path & Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), """ """ & Path & "") & """", vbHide
End Sub

Code: Select all

Sub FileToToss(strFileToToss As String)
 
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
If Not fso.FileExists(strFileToToss) Then
   WScript.Quit
End If
 
If fso.GetExtensionName(strFileToToss) = "exe" Then
   WScript.Quit
End If
 
strFolderParent = fso.GetParentFolderName(strFileToToss)
strFileName = fso.GetFileName(strFileToToss)
 
 
'   Make sure recycle bin properties are set to NOT display request for delete confirmation
 
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
  
strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Explorer"
strValueName = "ShellState"
 
oReg.GetBinaryValue HKEY_CURRENT_USER, strKeyPath, _
    strValueName, strValue
 
strOrigBinSet = strValue(4)
strValue(4) = 39
 
errReturnA = oReg.SetBinaryValue _
   (HKEY_CURRENT_USER, strKeyPath, strValueName, strValue)
 
 
'  Use the Shell to send the file to the recycle bin
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolderParent)
Set objFolderItem = objFolder.ParseName(strFileName)
 
objFolderItem.InvokeVerb ("Delete")
 
'  Restore the User's Property settings for the Recycle Bin

strValue(4) = strOrigBinSet
errReturnB = oReg.SetBinaryValue(HKEY_CURRENT_USER, strKeyPath, strValueName, strValue)

End Sub

Code: Select all

Sub FileToToss(strFileToToss As String)
 
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
 
Set fso = CreateObject("Scripting.FileSystemObject")
 On Error Resume Next
If Not fso.FileExists(strFileToToss) Then
   WScript.Quit
End If
 
If fso.GetExtensionName(strFileToToss) = "exe" Then
   WScript.Quit
End If
 
strFolderParent = fso.GetParentFolderName(strFileToToss)
strFileName = fso.GetFileName(strFileToToss)
 
 
'   Make sure recycle bin properties are set to NOT display request for delete confirmation
 
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
  
strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Explorer"
strValueName = "ShellState"
 
oReg.GetBinaryValue HKEY_CURRENT_USER, strKeyPath, _
    strValueName, strValue
 
strOrigBinSet = strValue(4)
strValue(4) = 39
 
errReturnA = oReg.SetBinaryValue _
   (HKEY_CURRENT_USER, strKeyPath, strValueName, strValue)
 
 
'  Use the Shell to send the file to the recycle bin
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolderParent)
Set objFolderItem = objFolder.ParseName(strFileName)
 
objFolderItem.InvokeVerb ("Delete")
 
'  Restore the User's Property settings for the Recycle Bin

strValue(4) = strOrigBinSet
errReturnB = oReg.SetBinaryValue(HKEY_CURRENT_USER, strKeyPath, strValueName, strValue)

End Sub

Code: Select all

Sub FindAndOpenFiles()
    Dim FilePath As String
    Dim r As Range
    FilePath = "C:\Users\One\Desktop\Test"
    Set r = Sheet1.Range("A1", Cells(Rows.Count, "A").End(xlUp))
    For Each c In r
        FileToToss (FilePath & "\" & c)
    Next c
End Sub

Code: Select all

Sub FindAndOpenFiles()
    Dim fileName As String
    Dim rall As Range
    FilePath = "C:\FolderTEST"
    
    With Sheets("Sheet1")
        Set rall = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
    End With
    fileName = Dir(FilePath & "\*.xlsx")
    Do Until fileName = ""
        If Application.CountIf(rall, fileName) = 0 Then
            Kill fileName
        End If
        fileName = Dir()
    Loop
End Sub