GoSub içinde tekrar gosub a gönderme yapınca karşılaşılan hata hakkında

[hsayar]

Merhabalar;
http://www.excel.web.tr/showthread.php?t=45766
yukarıdaki linkte sn. zeki hocamızın yapmış olduğu kodlarda kdları tek prosodürde toplamak için düzenleme yapmak istediğimde AltListem alt prosodüründe (goSub) kırmızı satırı kullanınca belli bir süre sonra next satırında hata veriyor sebebi nedir?

Sub SubHsr_KlasorIceriginiListele()
Dim klsrSec, klsrAra, klsrLst As Object, klsrMsUstu$
Dim dosya, yol As String, i, j As Long
 
Set klsrSec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
klsrMsUstu = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    If klsrSec = "Masaüstü" Or klasor = "Desktop" Then
        yol = klsrMsUstu
        GoSub AnaListem
        GoSub AltListem
    ElseIf klsrSec <> "Masa&#252;st&#252;" Then
        yol = klsrSec.Items.Item.Path
        GoSub AnaListem
        GoSub AltListem
    Else
        Exit Sub
    End If
Set klsrSec = Nothing
Set klsrLst = Nothing
Exit Sub
AnaListem:
    Cells.ClearContents
    dosya = Dir(yol & "\*.*")
    i = 1
    While dosya <> ""
        DoEvents
        i = i + 1
        Cells(i, 1) = yol & dosya
        dosya = Dir
    Wend
Return
Exit Sub
AltListem:
Set klsrLst = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
 
On Error GoTo sonraki
For Each klsrAra In klsrLst
    dosya = Dir(klsrAra.Path & "\*.*")
 
    While dosya <> ""
        DoEvents
        j = [a65000].End(3).Row + 1
        Cells(j, 1) = yol & "\" & dosya
        dosya = Dir
    Wend
    'MsgBox yol
   [COLOR=red][B]yol = klsrAra.Path: GoSub AltListem[/B][/COLOR]
    'AltListe (klsrAra.Path)
sonraki:
Next
Return
End Sub

 

[Ferhat Pazarçevirdi]

Halen daha GoSub komutu kullanılıyor mu ? İlginç ...

Kullanılan dil DOS-Basic olsa, anlarım ama çağımızda, GoSub'ın yerini alan bir sürü alternatif var ... GoSub kullanımı; acayip şekilde dikkat ister ... Üstelik, Return'le, farkında olmadan sonsuz döngülere bile girme ihtimaliniz var.

Bence, GoSub'la, kodunuzda belli bir satıra yönlendirdiğiniz komutları, ya Function ya da (Sub) Procedure olarak tekrar dizayn edin... İnanın bu daha kolay olur. Yarattığınız bu function veya procedüre'yi de, ana makronuzun içinden çağırın.

 

[hsayar]

Halen daha GoSub komutu kullanılıyor mu ? İlginç ...

Kullanılan dil DOS-Basic olsa, anlarım ama çağımızda, GoSub'ın yerini alan bir sürü alternatif var ... GoSub kullanımı; acayip şekilde dikkat ister ... Üstelik, Return'le, farkında olmadan sonsuz döngülere bile girme ihtimaliniz var.

Bence, GoSub'la, kodunuzda belli bir satıra yönlendirdiğiniz komutları, ya Function ya da (Sub) Procedure olarak tekrar dizayn edin... İnanın bu daha kolay olur. Yarattığınız bu function veya procedüre'yi de, ana makronuzun içinden çağırın.

Sn. Ferhat Hocam, aşağıda da görüleceği üzere kodları zeki bey sizin dediğiniz gibi dizayn etmiş ama ben on yere yönlendirme işini pek sevmediğim için tek prosodürde toplamak istemiştim. eğer imkansızsa hemen vageçiyorum. Ancak küçük bir umut varsa bile fena olmaz.

Alternatif. Office 2007 de FileSearch sorunu yaşayanlar için kullanışlıdır.

Sub Start()
Dim klasor As Object
 
Set klasor = CreateObject("Shell.Application").BrowseForFolder _
                    (0, "Lütfen bir klasor seçin !", 1)
 
Liste (klasor.Items.Item.Path)
AltListe (klasor.Items.Item.Path)
 
Set klasor = Nothing
End Sub
 
Private Sub Liste(yol As String)
Dim dosya As String, i As Long
 
    dosya = Dir(yol & "\*.*")
    i = 1
    While dosya <> ""
        DoEvents
        i = i + 1
        Cells(i, 1) = yol & dosya
        dosya = Dir
    Wend
End Sub
 
Private Sub AltListe(yol As String)
Dim fL As Object, f As Object, dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
 
On Error GoTo sonraki
For Each f In fL
    dosya = Dir(f.Path & "\*.*")
 
    While dosya <> ""
        DoEvents
        j = [a65000].End(3).Row + 1
        Cells(j, 1) = yol & "\" & dosya
        dosya = Dir
    Wend
 
    AltListe (f.Path)
sonraki:
Next
 
Set fL = Nothing
End Sub