Loop thru Files

[Jenawade]

I need a macro to run through the excel files in the parent folder, change the formulas to values (select all, copy, paste special: values) and save. I've tried altering existing code others have used but get all different errors. Can someone help?

 

[Domenic]

Try...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] wkb [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] wks [color=darkblue]As[/color] Worksheet
    
    strPath = "C:\Path\"  [color=green]'Change the path to your folder[/color]
    
    [color=darkblue]If[/color] Right(strPath, 1) <> "\" [color=darkblue]Then[/color] strPath = strPath & "\"
    
    strFile = Dir(strPath & "*.xls")
    
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(strFile) > 0
        [color=darkblue]Set[/color] wkb = Workbooks.Open(strPath & strFile)
        [color=darkblue]For[/color] [color=darkblue]Each[/color] wks [color=darkblue]In[/color] wkb.Worksheets
            [color=darkblue]With[/color] wks.UsedRange
                .Copy
                .PasteSpecial xlPasteValues
            [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=darkblue]Next[/color] wks
        wkb.Close savechanges:=[color=darkblue]True[/color]
        strFile = Dir
    [color=darkblue]Loop[/color]
    
    MsgBox "Completed...", vbInformation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]

 

[Jenawade]

Try...

[/CODE]

Woohoo, perfect; thanks so much!

 

[Domenic]

You're very welcome! Thanks for the feedback!

 

[pawest]

I have a similar question.

I am trying to loop through strings of file path names. I'm using a filesearch and .lookin to find the files. The tweak to the above code that I have to implement is that I don't want to include certain folders or certain dates. As a newcomer to VBA I'm having some trouble figuring it out. Instead of referencing cells, I'm pretty sure I need to use the left(...) and right(...) to reference the exact text I want/don't want in the string. Here is the code I have so far.

Sub ListFiles()
On Error Resume Next
Sheets.Add
Call CreateList
Call MsgBeSure
End Sub
Sub CreateList()
Dim filePath As Variant, fsObject As Variant, file As Variant
Dim i As Long, Lastrow As Long
Dim Count As Integer
Dim PFcell
Lastrow = Worksheets("Parameters").Range("F65536").End(xlUp).Row

With Application.FileSearch
.LookIn = Range("Drive")
.SearchSubFolders = Range("Include_Subfolders")
.Filename = "*.*"
.Execute

For Each filePath In .FoundFiles
i = 1 + i
Set fsObject = CreateObject("Scripting.FileSystemObject")
Set file = fsObject.GetFile(filePath)
If ActiveSheet.Cells(i, 5) <= Worksheets("Parameters").Range("Before_Date").Value Then

For Count = 19 To Lastrow
PFcell = Worksheets("Parameters").Cells(Count, 6).Value

'I realize that ActiveSheet... needs to be changed to specifying
'the exact characters referenced, due to the face that activesheet...
'references cells rather than characters. So, I will be using left and
'right commands to recognize the exact characters
If ActiveSheet.Cells(i, 3) = PFcell Then
flag = 1
Exit For
End If
Next Count

If flag <> 1 Then

ActiveSheet.Cells(i, 1) = file.Drive
ActiveSheet.Cells(i, 2) = file.Name
ActiveSheet.Cells(i, 3) = file.ParentFolder
ActiveSheet.Cells(i, 4) = file.Path
ActiveSheet.Cells(i, 5) = file.DateLastModified

End If

End If
Next filePath
.NewSearch

End With
End Sub
Sub MsgBeSure()
MsgBox "Do NOT move or delete gathered, stale data before consulting with your coworkers and supervisors and receiving their input. Be sure to sort and assess the gathered, stale data for file sequences or data that should not be deleted."
End Sub


Any help would be appreciated. Thanks!

 

[Domenic]

Unfortunately, I don't have time to look at this now. I'd suggest starting a new thread. Visibility is limited when you bury your question in someone else's thread.

 

[pawest]

Thanks for letting me know Domenic. If you have time to come back to this, please look at a thread titled "Searching for Files on Drive and Excluding Certain Files.

 

[pawest]

I figured it out... well with a lot of help from a programmer where I work! Now I have to move files and delete the old, stale files... I think I know how to do that though.

Sub ListFiles()
On Error Resume Next
Call CreateList
Call MsgBeSure
End Sub
Sub CreateList()
Sheets.Add
Dim filePath As Variant, fsObject As Variant, file As Variant
Dim i As Long, Lastrow As Long
Dim Count As Integer
Dim PFcell
Lastrow = Worksheets("Parameters").Range("F65536").End(xlUp).Row
With Application.FileSearch
.LookIn = Range("Drive")
.SearchSubFolders = Range("Include_Subfolders")
.Filename = "*.*"
.Execute

For Each filePath In .FoundFiles
Set fsObject = CreateObject("Scripting.FileSystemObject")
Set file = fsObject.GetFile(filePath)

'***The date of the file should be earlier than preset date****

If file.DateLastModified <= Worksheets("Parameters").Range("Before_Date").Value Then
For Count = 19 To Lastrow
PFcell = Worksheets("Parameters").Cells(Count, 6).Value

If Left(file.ParentFolder, Len(PFcell)) = PFcell Then
' If file.ParentFolder = Left(PFcell, Len(PFcell)) & "*" Then

GoTo 0
' End If
End If

Next Count
i = 1 + i
ActiveSheet.Cells(i, 1) = file.Drive
ActiveSheet.Cells(i, 2) = file.Name
ActiveSheet.Cells(i, 3) = file.ParentFolder
ActiveSheet.Cells(i, 4) = file.Path
ActiveSheet.Cells(i, 5) = file.DateLastModified

End If
0 Next filePath
.NewSearch


End With
End Sub
Sub MsgBeSure()
MsgBox "Do NOT move or delete gathered, stale data before consulting with your coworkers and supervisors and receiving their input. Be sure to sort and assess the gathered, stale data for file sequences or data that should not be deleted."
End Sub