Soru Klasör adlarını listelerken son açılan dosyayı listelemiyor

[seckinb]

Merhaba

1127. klasörü açmış bulunmaktayım.
listeleme için kullandığım bu kod, her seferinde sondan bir öncekine kadar listeliyor, ancak sonuncuyu göstermiyor.
nerede hata yapmış olabilirim?

Public Arr() As String

Public Counter As Long


Sub KlasorHIPER()

Dim myArr

Dim strPath As String

Dim WB As Workbook

Dim P1 As Worksheet

Set WB = ThisWorkbook

Set P1 = WB.Worksheets("P1")

P1.Select

Cells.ClearContents

Cells.Hyperlinks.Delete

Cells.Font.ColorIndex = 0

Cells.Interior.ColorIndex = 44



strPath = "S:\HIPER"

myArr = GetSubFolders(strPath)

[A1].Resize(UBound(myArr, 1), 1) = Application.Transpose(myArr)

Call VBAColumn1

Call findlastrow

End Sub



Function GetSubFolders(RootPath As String)

Dim FSO As Object

Dim fld As Object

Dim sf As Object

Dim myArr


Set FSO = CreateObject("Scripting.FileSystemObject")


Set fld = FSO.getfolder(RootPath)


For Each sf In fld.Subfolders

    ReDim Preserve Arr(Counter)

    Arr(Counter) = sf.Path

    Counter = Counter + 1

    myArr = GetSubFolders(sf.Path)

Next


GetSubFolders = Arr


Set sf = Nothing

Set fld = Nothing

Set FSO = Nothing

End Function


Sub VBAColumn1()


Range("B:B").Insert

 

With Range("B1:B" & Cells(Rows.count, "A").End(xlUp).Row)

        .Formula = "=MID(A1, 15, 4)"

      

End With


End Sub


Private Sub findlastrow()

Range("B1").End(xlDown).Copy

Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

With Range("a2")

    .NumberFormat = "0000"

    .Value = .Value

End With

End Sub

 

[ÖmerFaruk]

Kodlarını ve dosyanı incelemedim. Mesaja baktım sadece.

Arr(Counter) = sf.Path
Counter = Counter + 1

Bu iki satırın sırasını değiştirerek dener misin.
Counter = Counter + 1
Arr(Counter) = sf.Path

 

[seckinb]

Kodlarını ve dosyanı incelemedim. Mesaja baktım sadece.

Arr(Counter) = sf.Path
Counter = Counter + 1

Bu iki satırın sırasını değiştirerek dener misin.
Counter = Counter + 1
Arr(Counter) = sf.Path

"script out of range" hatası verdi ne yazık ki.

 

[Levent Menteşoğlu]

Aşağıdaki satıra renklendirdiğim eklemeyi yapın.

[A1].Resize(UBound(myArr, 1) + 1, 1) = Application.Transpose(myArr)