Loop through folder and check filename is same as on sheet?

[TheWennerWoman]

Hello,

We auto-generate approximately 400 profit & loss statements every month and these are saved to a folder.

What I'd like to do (as we have had some issues with statements being sent to the wrong cost centre) is have a macro that

(a) gives the user a folder picker where he/she selects where the current month's statements are saved
(b) opens a file in that folder
(c) checks that cell A3 of the sheet named "Finance" is the same as the first five characters of the file name
(d) lists the full filename if it is not
(e) closes the file without saving
(f) opens the next file and so on

How easy is this to achieve?

Thank you in advance as always for reading.

 

[eiloken]

Hello,

We auto-generate approximately 400 profit & loss statements every month and these are saved to a folder.

What I'd like to do (as we have had some issues with statements being sent to the wrong cost centre) is have a macro that

(a) gives the user a folder picker where he/she selects where the current month's statements are saved
(b) opens a file in that folder
(c) checks that cell A3 of the sheet named "Finance" is the same as the first five characters of the file name
(d) lists the full filename if it is not
(e) closes the file without saving
(f) opens the next file and so on

How easy is this to achieve?

Thank you in advance as always for reading.

try:

Option Explicit

Sub ListFilesInFolder()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim folder As FileDialog
    Dim xDir As String, xPath As String, xName As String
    Dim xFSO As Object, xFolder As Object, xFile As Object
    Dim wb As Workbook, ws As Worksheet, iList As Worksheet
    Set folder = Application.FileDialog(msoFileDialogFolderPicker)
    folder.Title = "Choose Folder"
    If folder.Show <> -1 Then Exit Sub
    Set iList = ThisWorkbook.Sheets(1)
    xDir = folder.SelectedItems(1)
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xDir)
    For Each xFile In xFolder.Files
        xPath = xFSO.GetAbsolutePathName(xFile)
        If xPath Like "*.xls*" Then
            xName = xFSO.GetFileName(xFile)
            Set wb = Workbooks.Open(xPath, 3, True)
            Set ws = FindSheet(wb, "Finance")
            If Not ws Is Nothing Then
                If Not UCase(Left(xName, 5)) = UCase(ws.Range("A3").Text) Then
                    iList.Range("A" & lr(iList, 1) + 1).Value = xName
                End If
            Else
                iList.Range("A" & lr(iList, 1) + 1).Value = xName
            End If
            wb.Close (False)
        End If
        Application.StatusBar = "Reading: " & xPath
        DoEvents
    Next xFile
    Application.StatusBar = False
    Set xFile = Nothing
    Set xFolder = Nothing
    Set xFSO = Nothing
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
End Sub

Private Function FindSheet(ByVal wb As Workbook, ByVal shName As String) As Worksheet
    On Error Resume Next
    Set FindSheet = wb.Sheets(shName)
End Function

Private Function lr(ByVal ws As Worksheet, ByVal icol As Integer) As Long
    lr = ws.Cells(Rows.Count, icol).End(xlUp).Row
End Function

 

[TheWennerWoman]

Genius, many thanks!