Delete File in folder [VBA]

[humnoy12]

รบกวนช่วยปรับ Code หน่อยครับ
1.อยากจะเมื่อลบไฟล์ตามชื่อที่คอลัมน์ A ของไฟล์ Delete file แล้วสามารถไป Restore ใน Recycle Bin ได้ครับ
ตอนนี้ติดที่ลบไปแล้วไม่สามารถ Restore ได้ครับ
2. อยากจะลบไฟล์ใน Folder ทั้งหมดยกเว้นไฟล์ชื่อตามคอลัมน์ A

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

[snasui]

ช่วยโพสต์ Code ที่เขียนเพื่อ Restore File พร้อมแนบไฟล์ที่มี Code นั้นมาด้วย จะได้ตอบต่อไปจากนั้นครับ

[humnoy12]

ไม่ทราบว่าจะเขียนยังไงครับ แต่อยากให้ว่าเมื่อลบไฟล์แล้วให้เข้าไปอยู่ใน Recycle Bin ไม่ต้องลบแบบถาวร
เดียวลองศึกษาหาข้อมูลก่อนครับ

[humnoy12]

อันนั้นนี้ Code ส่งไฟล์ไปที่ Recycle Bin Code นี้หามาได้ครับ
ด้วยความสามารถผมคงยังเขียนไมไ่ด้ขนาดนี้

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

[snasui]

อันนั้นนี้ Code ส่งไฟล์ไปที่ Recycle Bin Code นี้หามาได้ครับ
ด้วยความสามารถผมคงยังเขียนไมไ่ด้ขนาดนี้

ขอ Code ที่เขียนนำไฟล์จาก Recycle Bin กลับมาครับ

[humnoy12]

กรณีนำไฟล์กลับมาจาก Recycle Bin ไม่ต้องใช้ Code ครับ แค่เข้าไปเลือกบางไฟล์ที่ต้องการ Restore ครับ
ความต้องการคือ
1. ลบไฟล์จากชื่อที่คอลัมน์ A ลบแล้วให้ไปอยู่ใน Recycle Bin ครับ ถ้าต้องการนำไฟล์กลับมาเดียวเข้าไป Restore เฉพาะบางไฟล์ครับ
กับ
2. อยากจะลบไฟล์ทั้งหมดใน Folder ยกเว้นไฟล์ชื่อตามคอลัมน์ A

[snasui]

2. อยากจะลบไฟล์ทั้งหมดใน Folder ยกเว้นไฟล์ชื่อตามคอลัมน์ A

Loop เข้าไปยัง Folder แล้วตรวจสอบว่ามีชื่อไฟล์ในคอลัมน์ A หรือ ไม่ถ้าชื่อไม่ตรงลบทิ้ง สามารถนำ Code ตาม Link นี้มาประยุกต์ได้ครับ https://www.snasui.com/viewtopic.php?t=4645#p30182

[humnoy12]

ยังไม่ค่อยเข้าใจเรื่อง Loop เข้าไปใน Folder แล้วถ้าเจอชื่อไฟล์ที่ไม่ตรงกับคอลัมน์ A ให้ลบทิ้ง
ช่วยปรับ Code หน่อยครับ ลองดูอยู่นานก็ยังไม่ได้

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

[snasui]

ตัวอย่างการ Loop เพื่อลบไฟล์ที่ชื่อไม่ตรงกับชื่อไฟล์ในคอลัมน์ A ครับ

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