We help IT Professionals succeed at work.

Moving Folders

sumitabh
sumitabh asked
on
I am receiving some folders through FTP in my severs's 'MYFolder' everyday.I need to distribute the
received folders to 14 users,which has read access 14 different folders(their resepctive ids) in my
system.Also there is one Backup folder in my system which will be used for 10 days data retention.
My requirement is

1>. Move all the folders from 'MYFOLDER' to 'BACKUP' folder and empty 'MYFOLDER'.
2>. Distribute Folders from BACKUP to 14 individual folders evenly,in a way that if we have suppose
21 folders first 14 folders are distributed one each to 14 folders and rest 7 goes to first 7 folders.
3>. Check for retention period of 10 days in backup folder and then blow off folders 11 days old.

I am looking for full programming code.
Comment
Watch Question

Ark
CERTIFIED EXPERT

Commented:
Const MyFolder = "C:\MYFOLDER"
Const BackUpFolder = "C:\BACKUP"
Dim UserFolder(1 To 14) As String

Private Sub DoStaff()
   Dim FSO As Object
   Dim fld As Object
   Dim subfld As Object
   Dim i As Integer
   For i = 1 To 14
'Your user's path here
       UserFolder = "User" & i
   Next i
   Set FSO = CreateObject("Scripting.FileSystemObject")
'First, remove old folders
   Set fld = FSO.GetFolder(BackUpFolder)
   For Each subfld In fld.SubFolders
       If DateDiff("d", Now, subfld.DateCreated) > 10 Then subfld.Delete True
   Next
'Now, move folder
   FSO.MoveFolder MyFolder, BackUpFolder
'Copy to User's folders
   Set fld = FSO.GetFolder(BackUpFolder)
   For Each subfld In fld.SubFolders
       subfld.Copy UserFolder((i Mod 14) + 1)
       i = i + 1
   Next
   Set subfld = Nothing
   Set fld = Nothing
   Set FSO = Nothing
End Sub


Cheers
Ryan ChongSoftware Tead Lead / Business Analyst / System Analyst / Data Engineer
CERTIFIED EXPERT

Commented:
Hi sumitabh,

Use some API codes to do the copy process which will show the copy dialog along the process:

Public Type SHFILEOPSTRUCT
   hwnd As Long
   wFunc As Long
   pFrom As String
   pTo As String
   fFlags As Integer
   fAnyOperationsAborted As Boolean
   hNameMappings As Long
   lpszProgressTitle As String
End Type

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT)

As Long
Public Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40

Public Sub CopyFileWindowsWay(SourceFile As String, DestinationFile As String)
   Dim lngReturn As Long
   Dim typFileOperation As SHFILEOPSTRUCT

   With typFileOperation
      .hwnd = 0
      .wFunc = FO_COPY
      .pFrom = SourceFile & vbNullChar & vbNullChar 'source file
      .pTo = DestinationFile & vbNullChar & vbNullChar 'destination file
      .fFlags = FOF_ALLOWUNDO
   End With

   lngReturn = SHFileOperation(typFileOperation)

   If lngReturn <> 0 Then 'Operation failed
        IsSuccess = 1
   Else 'Aborted
        If typFileOperation.fAnyOperationsAborted = True Then
             MsgBox "Operation Failed", vbCritical Or vbOKOnly
        End If
   End If
End Sub

Use like:
CopyFileWindowsWay txtSourcePath, txtTargetPath

Or

Copy Files Using the Shell API
http://www.freevbcode.com/ShowCode.Asp?ID=499

Copy multiple files using ListBoxes
http://www.freevbcode.com/ShowCode.Asp?ID=1272

Easy File System Object Usage
http://www.freevbcode.com/ShowCode.Asp?ID=2383

'Hope will help.

Author

Commented:
I tried ur code,I am sending u the way I am trying to execute it but somehow I am unable to create the users,pls check it and reply
--------------------------------------------------------

<%@ LANGUAGE="VBSCRIPT" %>
<%
Dim Myfolder
Dim BackupFolder

 MyFolder = Server.MapPath("\FCM\")
 BackUpFolder = Server.MapPath("\Backup\") & "\"


'Response.Write MyFOlder
'Response.Write BackupFolder
'Response.End

Dim UserFolder(3)

For i = 1 To 2
'Your user's path here

UserFolder(i) = "User" & i
Response.Write Userfolder(i)

Next


Set FSO = CreateObject("Scripting.FileSystemObject")
'First, remove old folders

Set fld = FSO.GetFolder(BackUpFolder)
'Set SubFolder = FSO.GetFolder(Myfolder)

For Each subfld In fld.SubFolders
If DateDiff("d", Now, subfld.DateCreated) > 10 Then subfld.Delete True
Next

'Now, move folder
FSO.MoveFolder Server.MapPath("\FCM\") ,  Server.MapPath("\Backup\") & "\"

'Copy to User's folders
Set fld = FSO.GetFolder(BackUpFolder)

For Each subfld In fld.SubFolders
subfld.Copy UserFolder((i Mod 2) + 1)
i = i + 1
Next

Set subfld = Nothing
Set fld = Nothing
Set FSO = Nothing






%>
<HTML>
<!--------------- Created By EasyASP --------------->
<!----------- Copyright 2000 Eric Banker ----------->
<HEAD>
<title>Untitled Document</title>
</HEAD>

<body bgcolor="#FFFFFF" text="#000000" link="#804040" vlink="#008080" alink="#004080">
<!---------------- Insert Text Here ---------------->

Successfully Moved ......!!!!!

</BODY>
</HTML>
Ark
CERTIFIED EXPERT

Commented:
Hi
I assumed that you already have folders for users.

Dim UserFolder(3)

For i = 1 To 2
'Your user's path here

UserFolder(i) = Server.MapPath("User" & i) 'means that you already have 14 folders for users (User1...User12)
Response.Write Userfolder(i)

Next
CERTIFIED EXPERT
Commented:
If you want to create folder, use FSO.CreateFolder sPath

Author

Commented:
Though It didn't solved my problem but for the effort u put in,I am assigning u the points.

Explore More ContentExplore courses, solutions, and other research materials related to this topic.