HOW TO Save Processed Files Into Different Folders

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.

Code:

---



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

---

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?

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

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

Try This:

Code:

---


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

---

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.

Try this

Code:

---

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

---