Loop through folder

[Blackwater]

Hello,
I have two macros in my PERSONAL.xlsb, that does some formating and stuff to opened .csv file and autoclose it to certain location. However, since i started to operate with multiple files so i would like to ask if someone has some macro that does

1.) open file
2.) run macro (which in my case autosaves and close the file)
3.) proceed to open another file

--- and so on until all files has been processed ---


I have been searching here for the code, but none of the macros really worked, either, after runing the macro nothing happens, or it throw some error on me

I believe its really specific since i have it in personal.xlsb not a custom macro file..

If there is a solution or someone has some script that would help me and will post it here.. Thank you very much

 

[davesexcel]

You can adapt this code.
http://www.xlorate.com/vba-examples.html#Loop Through Folder

 

[Blackwater]

Thanks, i tried it but ended up with syntax error also whole code is in red..

https://ibb.co/i8kEp6

 

[davesexcel]

You should have just been able to copy and paste the code into your vb editor. Red writing usually means the spaces are not recognized.
Anyway here is the same code, hopefully it works.
I did notice you were running the code before you opened the wb though.

Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    'change the address to suite
    MyDir = "C:\WorkBookLoop\"
    MyFile = Dir(MyDir & "*.xls")    'change file extension
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)
    
    'your code
    ActiveWorkbook.save
    ActiveWorkbook.Close
        MyFile = Dir()
    Loop

End Sub

 

[Blackwater]

Hello, i tried the code you posted, adapted it to suit it for me, but well.. it doesnt do anything when i run it. No error, nothing

Sub LoopThroughFolder()
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    MyDir = "D:\CUBA\FA"
    MyFile = Dir(MyDir & "*.csv")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    Do While MyFile <> ""
        Workbooks.Open (MyFile)
    
    Call MakroFA
    ActiveWorkbook.Save
    ActiveWorkbook.Close
        MyFile = Dir()
    Loop
End Sub

 

[Blackwater]

Tried to edit the code, and fit it into one, also saved it as .xlsm with a macro in it.. behave the same, no action

'Loop throught Folder
Sub LoopThroughFolder()
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    MyDir = "D:\CUBA\FA"
    MyFile = Dir(MyDir & "*.csv")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0
    Do While MyFile <> ""
        Workbooks.Open (MyFile)
    
'MakroFA
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A13:I13").Select
    Range("I13").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("E:E,G:G,H:H").Select
    Range("H1").Activate
    Selection.NumberFormat = "0.00"
    Range("G13,E13").Select
    Range("E13").Activate
    Selection.NumberFormat = "m/d/yyyy"
    Range("G26").Select
    Range("A13:I13").Select
    Range("I13").Activate
    Selection.Font.Bold = True
    Range("C12").Select
            Dim lastRow As Long
lastRow = Range("A5000").End(xlUp).Row
Range("A" & lastRow + 1) = "Sumár"
Range("E" & lastRow + 1).Formula = "=SUM(E16:E" & lastRow & ")"
Range("G" & lastRow + 1).Formula = "=SUM(G16:G" & lastRow & ")"
Range("H" & lastRow + 1).Formula = "=SUM(H16:H" & lastRow & ")"
Dim lr As Long, r As Long
lr = ActiveSheet.UsedRange.Rows.Count
Range("A" & lr & ":H" & lr).Interior.ColorIndex = 35
    Dim xlBook
    Set xlBook = ActiveWorkbook
    ChDir "D:\01 SMT OUT\"
    ActiveWorkbook.SaveAs Filename:= _
                          "D:\01 SMT OUT\" & Left(xlBook.Name, (InStrRev(xlBook.Name, ".", -1, vbTextCompare) - 1)) & ".xlsx", FileFormat:= _
                          xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=True
        MyFile = Dir()
    Loop
End Sub

 

[davesexcel]

Is MyDir = "D:\CUBA\FA" correct? are you not missing a slash?

Step through the code and see what it is doing.

 

[Blackwater]

I added \ after FA and well it kinda Works. It doesnt, but it does something. It tries to open the first file in that folder but end up with error "FileName.csv" (there is name for this file as in my folder) Cannot be opened because it has been moved or deleted. But it wasnt! Its there. I double, triple checked and the file name macro reports as "not found" is there and exactly the same name.
When i click on debug it shows this line
Workbooks.Open (MyFile)

thanks for help

 

[John_w]

Change these lines as shown:

    MyDir = "D:\CUBA\FA\"
        Workbooks.Open MyDir & MyFile

 

[Blackwater]

Thanks! Amazing it works now! Thank you very much!