Excel VBA Macro To Copy Daily Task Files To Respective Day Folder
Scenario :
Suppose,there Different Files like TPR-03-JULY-2012.xlsx,SAS-03JULY-2012.Jpg,REDDY-03-JULY-2012.Docx
'When You Run This Macro It wil Create Folder a Day Folder,say '03-JULY-2012' and Copy all those Files to this Folder
Sub CopyDayFiles2DayFolder()
Dim FromPath As String
Dim ToPath As String
Dim FSO As Object
Dim File As Object
Dim FName As String
'Application.DisplayAlerts = False
On Error Resume Next
FromPath = "C:\Documents and Settings\Administrator\My Documents\"
ToPath = "F:\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " " & " Doesn't Exist"
Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " " & " Doesn't Exist"
Exit Sub
End If
For Each File In FSO.GetFolder(FromPath).Files
FName = Left(Right(File.Name, 15), 11)
If InStr(File.Name, FName) <> InStr(File.Name, FName) + 1 Then
MkDir "F:\" & FName
'File.Copy "F:\" & FName & "\" ' To Copy
File.Move "F:\" & FName & "\" ' To Move
End If
Next File
MsgBox "Your Daily Task Files Has Been Copied To Respective Day Folders",
vbOKCancel, "Successfull Copied"
End Sub
Scenario :
Suppose,there Different Files like TPR-03-JULY-2012.xlsx,SAS-03JULY-2012.Jpg,REDDY-03-JULY-2012.Docx
'When You Run This Macro It wil Create Folder a Day Folder,say '03-JULY-2012' and Copy all those Files to this Folder
Sub CopyDayFiles2DayFolder()
Dim FromPath As String
Dim ToPath As String
Dim FSO As Object
Dim File As Object
Dim FName As String
'Application.DisplayAlerts = False
On Error Resume Next
FromPath = "C:\Documents and Settings\Administrator\My Documents\"
ToPath = "F:\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " " & " Doesn't Exist"
Exit Sub
End If
If FSO.FolderExists(ToPath) = False Then
MsgBox ToPath & " " & " Doesn't Exist"
Exit Sub
End If
For Each File In FSO.GetFolder(FromPath).Files
FName = Left(Right(File.Name, 15), 11)
If InStr(File.Name, FName) <> InStr(File.Name, FName) + 1 Then
MkDir "F:\" & FName
'File.Copy "F:\" & FName & "\" ' To Copy
File.Move "F:\" & FName & "\" ' To Move
End If
Next File
MsgBox "Your Daily Task Files Has Been Copied To Respective Day Folders",
vbOKCancel, "Successfull Copied"
End Sub
#--------------------------------------------------------------Thanks--------------------------------------------------------------#
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.