Consulting

Results 1 to 4 of 4

Thread: MACRO help to delete some files in a particular folder

  1. #1
    VBAX Regular
    Joined
    Apr 2012
    Posts
    35
    Location

    MACRO help to delete some files in a particular folder

    Hi,
    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.

    Thanks
    Rathish

  2. #2
    VBAX Tutor mohanvijay's Avatar
    Joined
    Aug 2010
    Location
    MADURAI
    Posts
    268
    Location

  3. #3
    VBAX Regular
    Joined
    Apr 2012
    Posts
    35
    Location
    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.

    Regards
    Rathish


    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", _
    MultiSelect:=True)
    If IsArray(Fname) = False Then
    'Do nothing
    Else
    '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

  4. #4
    VBAX Tutor mohanvijay's Avatar
    Joined
    Aug 2010
    Location
    MADURAI
    Posts
    268
    Location
    You can use "Dir" function or Scripting libaray to the File existing

    You can delete file by using "Kill" function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •