HOW TO Save Processed Files Into Different Folders

[DARSHANKmandya]

I have following code: i Want to save the processed files into different folders.but in my code it is saving all files in one folder.How can i make the changes in my code to refelect all processed files in differnet folders.





Sub rrr()
'
' rrr Macro
'
' Keyboard Shortcut: Ctrl+r
'



'
' rrr Macro
'
' Keyboard Shortcut: Ctrl+r
'



'Change to the correct folder path, be sure to include the ending \
Const strFolderPath As String = "V:\RESG\GTS\STP-OSM\SOC\DashBoard\SandBox - confidential\Data Source - practice\darshan practice\sec alert\antivirus\March\raw data\New Folder\"

Dim strCurrentFile As String

Dim sDateFind As String
Dim sDateRep As String
Dim rLastCell As Range
Dim LR As Long


strCurrentFile = Dir(strFolderPath & "*.csv")

Application.ScreenUpdating = False


Do

With Workbooks.Open(strFolderPath & strCurrentFile)

Columns("E:E").Select
Selection.NumberFormat = "dd/mm/yy;@"
Columns("L:L").Select
Selection.NumberFormat = "dd/mm/yy;@"

LR = Cells(Rows.Count, "L").End(xlUp).Row
Range("L1:L" & LR) = Evaluate("IF(L1:L" & LR & "=0+""1/1/9999"",E1:E" & LR & _
",IF(LEN(L1:L" & LR & "),L1:L" & LR & ",""""))")


Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True



Workbooks.SaveAs FileName:= _
"P:\D2\macros\new act\"
.Close True

Workbooks.SaveAs FileName:= _
"P:\D2\macros\new act\"

End With
strCurrentFile = Dir
Loop While Len(strCurrentFile) > 0

Application.ScreenUpdating = True


MsgBox "Data formatting is completed successfully!!!!"


End Sub

[Excel Fox]

You mean you want to save each file in separate folders? So for example, after processing File A, you create a new folder, AFolder, and save the file within this folder, and then after processing File B, create a new folder, BFolder, and save the file within that folder? Is that what you need?

[DARSHANKmandya]

yes exactly...that is what am looking for......

[DARSHANKmandya]

hello...any update on above concern??????

[littleiitin]

Try This:




Sub rrr()




'Change to the correct folder path, be sure to include the ending \
Const strFolderPath As String = "V:\RESG\GTS\STP-OSM\SOC\DashBoard\SandBox - confidential\Data Source - practice\darshan practice\sec alert\antivirus\March\raw data\New Folder\"
Const strSaveFolder As String = "P:\D2\macros\new act\"
Dim strCurrentFile As String
Dim sDateFind As String
Dim sDateRep As String
Dim rLastCell As Range
Dim LR As Long
Dim wbkAct As Workbook
Dim strCreateFolder As String
strCurrentFile = Dir(strFolderPath & "*.csv")

Application.ScreenUpdating = False


Do
Workbooks.Open (strFolderPath & strCurrentFile)
Set wbkAct = ActiveWorkbook
With wbkAct

Columns("E:E").Select
Selection.NumberFormat = "dd/mm/yy;@"
Columns("L:L").Select
Selection.NumberFormat = "dd/mm/yy;@"

LR = Cells(Rows.Count, "L").End(xlUp).Row
Range("L1:L" & LR) = Evaluate("IF(L1:L" & LR & "=0+""1/1/9999"",E1:E" & LR & _
",IF(LEN(L1:L" & LR & "),L1:L" & LR & ",""""))")


Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True


strCreateFolder = strSaveFolder & ActiveWorkbook.Name
MkDir strCreateFolder
.SaveAs Filename:=strCreateFolder & "\" & ActiveWorkbook.Name
.Close True

End With
strCurrentFile = Dir
Loop While Len(strCurrentFile) > 0

Application.ScreenUpdating = True


MsgBox "Data formatting is completed successfully!!!!"


End Sub

[DARSHANKmandya]

yes its working...but i want to save those processed files into different different folders which is already existing.
i just need to mention the path.so that respective files will save into the given location.

ex: After processed
file1.csv-------->.../.../.../d1 folder
file2.csv-------->.../.../.../d2 folder etc...

How do i do this??
Please help me.

[Excel Fox]

Try this


Sub ExcelFox()

'Change to the correct folder path, be sure to include the ending \
Const strFolderPath As String = "V:\RESG\GTS\STP-OSM\SOC\DashBoard\SandBox - confidential\Data Source - practice\darshan practice\sec alert\antivirus\March\raw data\New Folder\"
Const strSaveFolder As String = "P:\D2\macros\new act\D"
Dim strCurrentFile As String
Dim sDateFind As String
Dim sDateRep As String
Dim rLastCell As Range
Dim LR As Long
Dim lngFileCount As Long
Dim wbkAct As Workbook
Dim strCreateFolder As String
strCurrentFile = Dir(strFolderPath & "*.csv")

Application.ScreenUpdating = False


Do
lngFileCount = lngFileCount + 1
Workbooks.Open (strFolderPath & strCurrentFile)
Set wbkAct = ActiveWorkbook
With wbkAct

Columns("E:E").NumberFormat = "dd/mm/yy;@"
Columns("L:L").NumberFormat = "dd/mm/yy;@"

LR = Cells(Rows.Count, "L").End(xlUp).Row
Range("L1:L" & LR) = Evaluate("IF(L1:L" & LR & "=0+""1/1/9999"",E1:E" & LR & _
",IF(LEN(L1:L" & LR & "),L1:L" & LR & ",""""))")
Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
strCreateFolder = strSaveFolder & lngFileCount & "\" & ActiveWorkbook.Name
MkDir strCreateFolder
.SaveAs Filename:=strCreateFolder & "\" & ActiveWorkbook.Name
.Close True
End With
strCurrentFile = Dir
Loop While Len(strCurrentFile) > 0

Application.ScreenUpdating = True


MsgBox "Data formatting is completed successfully!!!!"


End Sub