View Full Version : MACRO help to delete some files in a particular folder

10-10-2012, 08:07 AM
Can any one help me on the given below condition

I have lots of zipped file in a particular folder.
Inside each Zipped file there could be an email(.msg) 1 PPt, 1 Excel,1 Txt and 1 word.
I would like to unzip the folder
delete all the files except the email(.msg).
and then again to zip the folder.

If it is possible It would be a very big help for me.


10-10-2012, 11:09 PM
This will help you


10-11-2012, 06:13 AM
Thank You very Much for a quick response.

Given below code is useful for me. However is it possible to add a check to delete if that folder consist of 1 or more excel files or word file. Please help.


Sub Unzip4()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim I As Long
Dim num As Long
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
If IsArray(Fname) = False Then
'Do nothing
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\"
DefPath = "C:\Users\rradishkumar\Desktop\Test\UNZIPPED FILES"
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
For I = LBound(Fname) To UBound(Fname)
num = oApp.Namespace(FileNameFolder).items.Count
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(I)).items
Next I

MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub

10-11-2012, 11:30 PM
You can use "Dir" function or Scripting libaray to the File existing

You can delete file by using "Kill" function