HOW TO Save Processed Files Into Different Folders

**DARSHANKmandya** · 03-22-2013, 07:21 PM

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

**Excel Fox** · 03-22-2013, 08:57 PM

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** · 03-22-2013, 10:02 PM

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

**DARSHANKmandya** · 03-25-2013, 08:24 PM

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

**littleiitin** · 04-04-2013, 05:22 PM

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

**DARSHANKmandya** · 04-09-2013, 03:28 PM

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** · 04-10-2013, 07:29 PM

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