To Zip the folder and delete the files present in it..

To Zip the folder and delete the files present in it..

myFolder = "C:\Documents and Settings\Ayaskant Jena\Desktop\Source Folder"

myZipFile = "C:\Documents and Settings\Ayaskant Jena\Desktop\Source Folder\" &"Output_File_"

'msgbox myZipFile

Call ZipFolder( myFolder, myZipFile )

　

　

　

Function ZipFolder( myFolder, myZipFile )

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 new_date = split(date,"/")

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 new_time = split(time,":")　　　　　　　　　　

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 now_latest = new_time(0)&new_time(1)& new_time(2)&"_" &new_date(0)&new_date(1)&new_date(2)

　　　　　　　　　　　　　　　 myZipFile = myZipFile &now_latest &".zip"

'　　　　　　　　　　　　　　 msgbox myZipFile

　　　 Dim intSkipped, intSrcItems

　　　 Dim objApp, objFolder, objFSO, objItem, objTxt

　　　 Dim strSkipped

　　　 Const ForWriting = 2

　　　 intSkipped = 0

　　　 If Right( myFolder, 1 ) <> "\" Then

　　　　　　　 myFolder = myFolder & "\"

　　　 End If

　　　 On Error Resume Next

　　　 Set objFSO = CreateObject( "Scripting.FileSystemObject" )

　　　　　　　　　　　　　　　

　　　　　　　　　　　　　　　 If　 objFSO.FileExists(myZipFile)Then

　　　　　　　 objFSO.DeleteFile myZipFile, True

　　　　　　　　　　　　　　　 End If

　　　　　　　　　　　　　　　

　　　 Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )

　　　 objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )

　　　 objTxt.Close

　　　 Set objTxt = Nothing

　If Err Then

　　　　　　　 ZipFolder = Array( Err.Number, Err.Source, Err.Description )

　　　　　　　 Err.Clear

　　　　　　　 On Error Goto 0

　　　　　　　 Exit Function

　　　 End If

　　　

　　　 Set objApp = CreateObject( "Shell.Application" )

　　　 For Each objItem in objApp.NameSpace( myFolder ).Items

　　　　　　　 If objItem.IsFolder Then

　　　　　　　　　　　 Set objFolder = objFSO.GetFolder( objItem.Path )

　　　　　　　　　　　 If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then

　　　　　　　　　　　　　　　 intSkipped = intSkipped + 1

　　　　　　　　　　　 Else

　　　　　　　　　　　　　　　 objApp.NameSpace( myZipFile ).CopyHere objItem

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 '　　　　　　　　　　　　　　 msgbox objItem

　　　　　　　　　　　 End If

　　　　　　　 Else

　　　　　　　　　　　 objApp.NameSpace( myZipFile ).CopyHere objItem

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 'msgbox objItem

　　　　　 End If

　　　 Next

wait(10)

msgbox "okok"

Set objApp = CreateObject( "Shell.Application" )

　　　 For Each objItem in objApp.NameSpace( myFolder ).Items

　　　　　　 If objItem <> myZipFile Then

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 objFSO.deletefile ( "C:\Documents and Settings\Ayaskant Jena\Desktop\Source Folder\" & objItem & ".xls*")

　　　　　　　　　　　　　　　 End If

Next

　

　

　

　

　

　

　　　 Set objFolder = Nothing

　　　 Set objFSO　　　 = Nothing

　　　 ' Abort on errors

　　　 If Err Then

　　　　　　　 ZipFolder = Array( Err.Number, Err.Source, Err.Description )

　　　　　　　 Set objApp = Nothing

　　　　　　　 Err.Clear

　　　　　　　 On Error Goto 0

　　　　　　　 Exit Function

　　　 End If

　　　 ' Keep script waiting until compression is done

　　　 intSrcItems = objApp.NameSpace( myFolder　 ).Items.Count

　　　 Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems

　　　　　　　 WScript.Sleep 200

　　　 Loop

　　　 Set objApp = Nothing

　　　 ' Abort on errors

　　　 If Err Then

　　　　　　　 ZipFolder = Array( Err.Number, Err.Source, Err.Description )

　　　　　　　 Err.Clear

　　　　　　　 On Error Goto 0

　　　　　　　 Exit Function

　　　 End If

　　　 ' Restore default error handling

　　　 On Error Goto 0

　　　 ' Return message if empty subfolders were skipped

　　　 If intSkipped = 0 Then

　　　　　　　 strSkipped = ""

　　　 Else

　　　　　　　 strSkipped = "skipped empty subfolders"

　　　 End If

　　　 ' Return code 0 (no error occurred)

　　　 ZipFolder = Array( 0, intSkipped, strSkipped )

End Function