Using Dir(ActiveWorkbook.FullName) Causes Macro to Stop Working

[EBexcel]

Hey all, I've inherited a macro that I'm trying to modify to capture additional info. Currently, the macro extracts data from all spreadsheets in a folder (that meet certain conditions). However, when I add in the commands to grab the filename, it causes the macro to only successfully loop through 1 file before stopping.

Here's my complete code:

Sub File()

ThisBookName = ActiveWorkbook.Name

Dim oWbk As Workbook
Dim sFil As String
Dim sPath As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'Location of files
    sPath = ActiveWorkbook.Path
    ChDir sPath

    If Len(Dir(sPath & "\Done", vbDirectory)) = 0 Then
        MkDir (sPath & "\Done")
    End If
    
    sFil = Dir(sPath & "\*.xls*") 'change or add formats
    
    'Start LOOP until all files in folder sPath have been looped through
    Do While sFil <> ""

        If sFil Like "Weekly DC*.xlsm" Then
            'ElseIf sFil Like "5061*" Then ' total bales divided by 7 stores
            'ElseIf sFil Like "5296*" Then ' both PLS & OCC, BOL = DC + Release
            'ElseIf sFil Like "5047*" Then ' both PLS & OCC
        Else
            Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file
            Call Copy

            Application.DisplayAlerts = False
            'close the BOL workbook
            oWbk.Close False
            'Move the BOL workbook into a new folder called DONE
            Name sPath & "\" & sFil As sPath & "\Done\" & sFil
        End If
        
        sFil = Dir
    'End of LOOP
    Loop
    
    'Call Filter

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Sub Copy()
    
    Dim CO As String
    Dim DTE As String
    Dim TRLR As String
    Dim BOL As String
    Dim REL As String
    Dim CAR As String
    Dim COM As String
    Dim TYP As String
    Dim QTY As String
    Dim NextRow As Long
    Dim FN As String
    
    CurrentBookName = ActiveWorkbook.Name
    Dim wks As Worksheet

    'On Error Resume Next
        For Each wks In ActiveWorkbook.Worksheets
            For I = 29 To 36
                If UCase(wks.Name) = UCase("BOL") Then
                    wks.Activate
                
                'For I = 29 To 36
                    If Trim(Range("A" & I)) <> "" Then
                        'Unmerge cells
                        Range("B10:D10").UnMerge
                        Range("D4:E6").UnMerge
                        Range("J3:J6").UnMerge
                        Range("H10:J10").UnMerge
                        Range("B18:D18").UnMerge
                        Range("C29:G29").UnMerge
                        Range("C30:G30").UnMerge
                        Range("C31:G31").UnMerge
                        Range("C32:G32").UnMerge
                        Range("C33:G33").UnMerge
                        Range("C34:G34").UnMerge
                        Range("C35:G35").UnMerge
                        Range("C36:G36").UnMerge
                                                
                        'Copy values
                        CO = Range("B10")
                        DTE = Range("B8")
                        TRLR = Range("D4")
                        BOL = Range("J3")
                        REL = Range("H10")
                        CAR = Range("B18")
                        QTY = Range("A" & I)
                        COM = Range("I16")
                        TYP = Range("C" & I)
                        'FN = Dir(ActiveWorkbook.FullName)
                                        
                        'Dim LastRow As Long
                        'LastRow = Range("G65536").End(xlUp).Row
                        'Range("A29:" & "I" & LastRow).Select
    
                        'Selection.Sort Key1:=Range("G18"), Order1:=xlAscending, Header:=xlGuess, _
                        'OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                        'DataOption1:=xlSortNormal
    
                        'Dim FinalRow As Long
                        'FinalRow = Range("G65536").End(xlUp).Row
                        'Range("A18:" & "I" & FinalRow).Select
                        'Selection.Copy
                        Windows("Weekly DC Import Non HD - T2.xlsm").Activate
                        NextRow = Range("G65536").End(xlUp).Row + 1
                        Range("A" & NextRow).Select
                        'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                        'ThisWorkbook.Sheets("Import").Range("P" & NextRow).Value = FN
                        ThisWorkbook.Sheets("Import").Range("A" & NextRow).Value = CO
                        ThisWorkbook.Sheets("Import").Range("B" & NextRow).Value = DTE
                        ThisWorkbook.Sheets("Import").Range("C" & NextRow).Value = TRLR
                        ThisWorkbook.Sheets("Import").Range("D" & NextRow).Value = BOL
                        ThisWorkbook.Sheets("Import").Range("E" & NextRow).Value = REL
                        ThisWorkbook.Sheets("Import").Range("F" & NextRow).Value = CAR
                        ThisWorkbook.Sheets("Import").Range("G" & NextRow).Value = QTY
                        ThisWorkbook.Sheets("Import").Range("H" & NextRow).Value = COM
                        ThisWorkbook.Sheets("Import").Range("I" & NextRow).Value = TYP
                    Else
                        'Skip this line and check the next one
                    End If
                'Next I
            
                End If
            Next I
        Next wks

End Sub

***************************************************************************
I think it has to do with me using ActiveWorkbook vs ThisWorkbook (for variable FN) but I can't, for the life of me, figure out how to fix it. I've searched online and couldn't find a solution. Any suggestions are greatly appreciated!

 

[Norie]

If you want to get the filename of the active workbook don't use Dir, especially if you are using Dir to find files.

FN = ActiveWorkbook.Name

 

[EBexcel]

This worked great, thank you Norie!