help with data project

[r121a947]

I have hundreds of folders, eachfolder containing from several dozen to several thousand .MP3 files. The program that creates the files adds a consecutive number to eachfile name (song title).


The program sometimes fails to convertall of the input songs, and the output folder does not have a filefor that song, with that song's consecutive number missing from thefolder.


I am looking for the best and easiestway to find which songs, if any, are missing from a folder . . .


I have a basic idea of what will work,but no idea how best to implement the steps:

1. Capture a folder's file list in a format that will easily paste/import into Excel, into individual columns.

1. Extract the consecutive number from each file name, and place in a new column.

1. Use a loop to compare row n+1 against row n; if the difference = 1, do nothing, next loop; else, place a character in a cell for row n+1, next loop.

A screenshot of the folder listing isattached. It shows that numbers 247, 255, 260, 264, 268, 270, and271 are missing.


Any and all help will be greatlyappreciated. Thanks, in advance.

[rollis13]

Just to get you started since your approach is correct (well, to me it makes sense). As per point 1) you can use this snippet I use to list files from a folder. As is it only lists the files in the folder you select. It can be pasted in a standard vba module and output will be in the activesheet.

Option Explicit

Sub ListFilesinFolder()


    Dim fso    As Object
    Dim fld    As Object
    Dim cnt    As Long
    Dim f      As Object
    Dim myDir  As String


    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            myDir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Set fso = CreateObject("Scripting.Filesystemobject")
    Set fld = fso.getfolder(myDir).Files
    Application.ScreenUpdating = False
    Range("A1") = "File Name"
    For Each f In fld
        cnt = cnt + 1
        Range("A1").Offset(cnt) = f.Name
    Next f
    Columns("A").AutoFit
    Application.ScreenUpdating = True
    Set fso = Nothing
    Set fld = Nothing
    
End Sub

[Bob Phillips]

Off topic a tad, but going by that thumbnail, you have good taste

[r121a947]

Thank you.

Doing one folder at a time will work well.

I will let you know how things work out.

Thanks, again.

[r121a947]

Using the ListFiles sub gave me the info in a form I could use.

Fumbling thru, I got the following two subs to get the job done. I suspect that someone who actually knows what to do and how to do it could greatly improve what I have done.

Any and all help is greatly appreciated.

Public Sub ExtractNum()
Dim lr As Long
    lr = Range("C" & Rows.Count).End(xlUp).Row
Dim AnyString, MyStr
Dim SearchString, SearchChar, MyPos
For i = 1 To lr
SearchString = ActiveCell.Value    ' String to search in; C1
SearchChar = "."    ' Search for ".".
MyPos = InStr(1, SearchString, SearchChar, 1)
AnyString = SearchString    ' Define string; C1 value
MyStr = Left(AnyString, MyPos - 1)   ' Returns
ActiveCell.Offset(0, -2).Value = MyStr
ActiveCell.Offset(1, 0).Select
Next i
End Sub

Public Sub GetMissingNums()
Dim lr As Long
    lr = Range("C" & Rows.Count).End(xlUp).Row


For i = 2 To lr
    If Range("A" & i).Value - Range("A" & i - 1).Value > 1 Then Range("B" & i).Value = "#"
    
Next i
End Sub

[rollis13]

You can cut it down to a single macro. Be aware that there is no error checking so in case there is a file name without leading number the macro will break to Debug.

Option Explicit
Public Sub ExtractMissingNum()
    Dim lr     As Long
    Dim MyStr
    Dim SearchString, SearchChar, MyPos
    Dim i      As Long
    lr = Range("C" & Rows.Count).End(xlUp).Row
    For i = 2 To lr
        With Range("C" & i)
            SearchString = .Value
            SearchChar = "."
            MyPos = InStr(1, SearchString, SearchChar, 1)
            MyStr = Left(SearchString, MyPos - 1)
            .Offset(0, -2).Value = MyStr
        End With
        If Range("A" & i).Value - Range("A" & i - 1).Value > 1 Then Range("B" & i).Value = "#"
    Next i
End Sub

[r121a947]

Thank you. That looks great!

There is one problem . . .

I do some manual work on the files between running the three subs.

After running ListFiles, the filenames are in A, and I insert two columns to the left of A, making it C.

Then I run Extract (with the cursor in C1), which populates A. But, the filenames are not in "absolute" numerical order, so I Sort, by row, on column A, to get the filenames, and the values in A, in correct numerical order.

Then I run GetMissing, and scroll down B to find the misses.

It's annoying that the default sort in Windows folders doesn't do an actual numerical sort. Is there a way to sort the folder in correct numerical order, first? That would make your solution much easier to implement.

Thanks, again, for your extra effort.

[rollis13]

Well, just some Cut&Paste and that's it = All-In-One (hope I didn't miss anything).

Option Explicit
Sub CheckFileNumbersInFolder()
    Dim myDir  As String
    Dim fso    As Object
    Dim fld    As Object
    Dim f      As Object
    Dim cnt    As Long
    Dim lr     As Long
    Dim rngSort As Range
    Dim MyStr
    Dim SearchString, SearchChar, MyPos
    Dim i      As Long
    'select folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            myDir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    Set fso = CreateObject("Scripting.Filesystemobject")
    Set fld = fso.getfolder(myDir).Files
    Application.ScreenUpdating = False
    'list file names to column C
    With ActiveSheet
        .Range("C1") = "File Name"
        For Each f In fld
            cnt = cnt + 1
            .Range("C1").Offset(cnt) = f.Name
        Next f
        Set fso = Nothing
        Set fld = Nothing
        .Columns("C").AutoFit
        lr = .Range("C" & .Rows.Count).End(xlUp).Row
        'extract numbers to column A
        For i = 2 To lr
            With .Range("C" & i)
                SearchString = .Value
                SearchChar = "."
                MyPos = InStr(1, SearchString, SearchChar, 1)
                MyStr = Left(SearchString, MyPos - 1)
                .Offset(0, -2).Value = MyStr
            End With
            'sort on column A
            .Sort.SortFields.Clear
            .Sort.SortFields.Add2 Key:=Range("A2:A" & lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            Set rngSort = .Range("A1:C" & lr)
            With .Sort
                .SetRange rngSort
                .Header = xlYes
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            'mark if missing numbers
            If .Range("A" & i).Value - .Range("A" & i - 1).Value > 1 Then .Range("B" & i).Value = "#"
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

[r121a947]

Thanks . . .

[r121a947]

You really put a lot of extra effort in to this. Thanks.

One minor detail . . .

It seems to always find the difference between 9 and 10 and the difference between 99 and 100 is > 1 . . . Can't imagine why.

Thank you for making this a whole lot easier than I ever thought it would be.