Excel VBA connected to external files

[TomExcel1234]

Hello,

i would appreciate any help in building macro for the task below, please. Heres a brief summary:

Issue:
I have list of image frames in sequential order (for instance from frame 1 to frame 10'000 or 20'000). The frames are either in .jpg or .png format. The issue is that from time to time, some frames are missing = for instance, the frame sequence would be .... 10'000.png, 10'001.png, 10'002.npg, 10'004.png... etc (hence frame 10'003.png missing).

Desired Macro:
The macro should go into the folder and see what frames are missing in sequence. If no frames are missing => do nothing. If frames are missing => then macro should take previous frame, copy it and rename it to fill the sequence. For instance:

Before macro is run:
Sequence would be .... 10'000.png, 10'001.png, 10'002.png, 10'004.png (one frame 10'003.png is missing)
After macro is run:
Sequence would be .... 10'000.png, 10'001.png, 10'002.png, 10'003.png 10'004.png (frame 10'003.png is a copy of 10'002.png to fill the sequence)

In case multiple frames are missing in a row, then the logic remains the same:

Before macro is run:
Sequence would be .... 10'000.png, 10'001.png, 10'002.png, 10'006.png (three frames 10'003.png, 10'004.png and 10'005.png are missing)
After macro is run:
Sequence would be .... 10'000.png, 10'001.png, 10'002.png, 10'003.png 10'004.png, 10'005.png, 10'006.png (frames 10'003.png, 10'004.png and 10'005.png are all a copy of frame 10'002.png to fill the sequence)

The macro would be based on naming of the files only. It would neither open nor analyze frames themselves.

Thank you very much for any help.

Best regards.

 

[bobsan42]

How do you define a sequence?
Which is the first and which is the last file in a sequence?
How do you find out if the first/last frame(s) in a sequence are missing?
Or is it all just one sequence and the gaps need to be filled?
Are the filenames only numbers, but unfortunately with a different number of digits?

 

[TomExcel1234]

How do you define a sequence?
Which is the first and which is the last file in a sequence?
How do you find out if the first/last frame(s) in a sequence are missing?
Or is it all just one sequence and the gaps need to be filled?
Are the filenames only numbers, but unfortunately with a different number of digits?

Hello,

i export image sequence from videos so the regular image sequence would be picture files (.png or .jpg) starting from 00001.jpg till the end of sequence (if video has 20'000 pictures, last file is named 20'000.jpg). If macro cannot be set up this way, i can manually input first and last number in the sequence.

Numbers are always integer and they are always padded with zeroes in front and always with the name number of digit. Thus the numbers would go from "00001.png" to "20'000.png", not from "1.png" to "20'000.png". There is no text in the name of the file.

First and last frame in sequence are never missing, it is always the files in between. When i export video as image sequence, some frames are either corrupt or duplicate so I remove them. Thus, in 20'000 images sequence, missing frames can be frames number 238, 469, 673 etc... in the naming, they would skip the order so i would just have files 00237.png and 00239.png because 00238.png was deleted. Thus, it is as you say, is is all just one sequence and the gaps need to be filled.

Hope this answered your questions. Please, let me know.

Thank you again for your help.

Best regards

 

[bobsan42]

Is there a limit for missing sequential frames?
And what happens if it is reached?

 

[TomExcel1234]

Is there a limit for missing sequential frames?
And what happens if it is reached?

What do you mean by limit, please? Usually its about 500 missing frames per 20'000 frames in a video. Sometimes it's less, sometimes it's more.

In most cases, missing frames are usually spread out across the sequence, not following each other. In couple instances, it could be 2-3 missing frames in a row. In that case, the previous frame should be copied 2-3 times (or x-times it is missing in a sequence row). I do not think i had cases where 4-5 frames were missing in a row.

Does that answer your question, please? Thank you kindly in advance.

 

[bobsan42]

Yes, i meant a limit for missing frames in a row. For example if it happens to have 24 o 30 missing in a row maybe you'll have to handle it differently.

 

[TomExcel1234]

Yes, i meant a limit for missing frames in a row. For example if it happens to have 24 o 30 missing in a row maybe you'll have to handle it differently.

yeah, that would be very unlikely. The maximum i had so far was 3 frames in a row (maybe 5 max in rare instances), so such situation of 24-30 frames in a row should not occur.

 

[bobsan42]

ok, it's not refined and overly tested but probably works:

Option Explicit

Const FEXTS = "png,jpg,jpeg"

Sub Main()
    Dim fld As String, obj
    
'Select the folder to scan for image files
    Set obj = BrowseFolder
    If obj Is Nothing Then GoTo ep
    With obj
        If .SelectedItems.Count <> 1 Then GoTo ep
        fld = .SelectedItems(1)
    End With
    fld = fld & Application.PathSeparator
    Dim alist, x, i As Long, ext As String, fmt As String
    x = Split(FEXTS, ",")
    
'Get the folder contents and Check the image files extension
    With CreateObject("WScript.Shell")
        For i = 0 To UBound(x)
            ext = x(i)
            alist = .Exec("CMD /S /C dir """ & fld & "*." & ext & """ /s /ON /b ").StdOut.ReadAll
            alist = Split(alist, vbCrLf)
            If UBound(alist) >= 0 Then Exit For
        Next i
    End With
    If UBound(alist) < 0 Then
        MsgBox "No " & FEXTS & " files found in folder:" & vbLf & fld, vbCritical
        GoTo ep 'no files in the folder
    End If
    
    Dim fmin As Long, fmax As Long
'Find last file number
    x = alist(UBound(alist) - 1)
    x = Split(x, Application.PathSeparator)
    x = x(UBound(x))
    fmt = Split(x, ".")(0)
    If Not IsNumeric(fmt) Then
        MsgBox "Wrong filename pattern in folder:" & vbLf & fld, vbCritical
        GoTo ep 'no files in the folder
    End If
    fmax = Val(fmt)
    
'Find first file number
    x = alist(0)
    x = Split(x, Application.PathSeparator)
    x = x(UBound(x))
    fmt = Split(x, ".")(0)
    If Not IsNumeric(fmt) Then
        MsgBox "Wrong filename pattern in folder:" & vbLf & fld, vbCritical
        GoTo ep 'no files in the folder
    End If
    fmin = Val(fmt)
    
'Set filename format
    fmt = String$(Len(fmt), "0")
    
    Dim sh As Worksheet, rng As Range
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
'setup a sheet to write information
    With ThisWorkbook.Worksheets
        Set sh = .Add(, .Item(.Count))
    End With
    sh.Name = "FrameScan " & Format(Now, "yymmdd hhmmss")
    With sh
        .Range("A1").Value = fld
        .Range("A2:A8") = Application.WorksheetFunction.Transpose(Array("EXT:", "Format:", "Count:", "Min:", "Max:", "", "Missing frames"))
        .Range("B2:B8") = Application.WorksheetFunction.Transpose(Array(ext, "'" & fmt, UBound(alist) - 1, fmin, fmax, "", ""))
        
        Set rng = .Range("A9")
    End With
'    With rng.Resize(UBound(alist) + 1, 1)
'        .Value = Application.WorksheetFunction.Transpose(alist)
'        .Interior.Color = vbYellow
'    End With
    
    Dim j As Long, k As Long, nm As String, str As String, LastFile As String, LastNum As Long, cnum As Long, delta As Long
    
'Checking for missing files in the sequence
    LastNum = fmin
    LastFile = alist(0)
    For i = (LBound(alist) + 1) To (UBound(alist) - 1)
        cnum = getNum(alist(i))
        If cnum < 0 Or cnum < LastNum Then MsgBox "Error @: " & alist(i): GoTo ep
        delta = cnum - LastNum - 1
'if filenames are not sequential - some are missing
        If delta > 0 Then
            For k = 1 To delta
                nm = Format(LastNum + k, fmt) & "." & ext
'Copy the last found file to replace a missing one
                fso.CopyFile Source:=LastFile, Destination:=fld & nm
'Log the missing filenames
                rng.Value = nm
                Set rng = rng.Offset(1)
            Next k
        End If
        LastNum = cnum
        LastFile = alist(i)
    Next i
ep:
    On Error Resume Next
    obj = Null
    alist = Null
    x = Null
    Set sh = Nothing
    Set fso = Nothing
    Set rng = Nothing
    
End Sub

Function getNum(ByVal fn As String) As Long
    Dim str As String, x
    x = Split(fn, Application.PathSeparator)
    str = x(UBound(x))
    str = Split(str, ".")(0)
    If Not IsNumeric(str) Then str = "-1"
    getNum = Val(str)
End Function

Function BrowseFolder() As FileDialog
    Set BrowseFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With BrowseFolder
        .Title = "Select directory with frames sequence"
        .AllowMultiSelect = False
        If .Show = 0 Then Set BrowseFolder = Nothing: Exit Function
    End With
End Function

just put it in a module and call the sub Main.
It may freeze your app until it's done.

 

[bobsan42]

Run it on a test folder first JIC
And make sure all leading zeros are in place.

 

[TomExcel1234]

Run it on a test folder first JIC
And make sure all leading zeros are in place.

One word. Blown away!
I tested it on 2'500 sample. Didn't even freeze, results were instant and all duplicates were correct... You are the boss!
Thank you so so so so much. You are truly a heaven sent!