Kansion alikansiot

Repe43

Tarttis saada Excelin hyperlinkkeinä, onnistuuko suoraan jotenkin vai lisäämällä kansio kerrallaan. Alikansioita on 100 ja lisää tulee koko ajan.

repe

7

737

    Vastaukset 7

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • moduuliin...

      ' lisää referenssi Microsoft Scripting Runtime
      Sub Alikansiot()
      Sheets("Hyperlinkit").Cells = ""
      HaeAlikansiot "H:\Excel\" ' muuta kansiopolku
      End Sub

      Sub HaeAlikansiot(Kansio As String)

      Dim FSO As Scripting.FileSystemObject
      Dim Lähde As Scripting.Folder
      Dim Alikansio As Scripting.Folder
      Dim rivi As Long

      Set FSO = New Scripting.FileSystemObject
      Set Lähde = FSO.GetFolder(Kansio)
      rivi = Range("A65536").End(xlUp).Row 1
      Cells(rivi, 1).Formula = Lähde.Path
      Cells(rivi, 1).Hyperlinks.Add Anchor:=Cells(rivi, 1), Address:=Lähde.Path
      For Each Alikansio In Lähde.SubFolders
      HaeAlikansiot Alikansio.Path
      Next Alikansio
      Set Alikansio = Nothing
      Columns("A").AutoFit
      Set Lähde = Nothing
      Set FSO = Nothing
      End Sub

      • Repe43

        Missä teen väärin? Herjaa noista riveistä

        Sub HaeAlikansiot(Kansio As String)

        Dim FSO As Scripting.FileSystemObject


      • kunde
        Repe43 kirjoitti:

        Missä teen väärin? Herjaa noista riveistä

        Sub HaeAlikansiot(Kansio As String)

        Dim FSO As Scripting.FileSystemObject

        kuten viestissä mainitaan

        ' lisää referenssi Microsoft Scripting Runtime
        Sub Alikansiot()
        Sheets("Hyperlinkit").Cells = ""
        HaeAlikansiot "H:\Excel\" ' muuta kansiopolku
        End Sub

        et ole lisännyt viittausta


      • Repe43
        kunde kirjoitti:

        kuten viestissä mainitaan

        ' lisää referenssi Microsoft Scripting Runtime
        Sub Alikansiot()
        Sheets("Hyperlinkit").Cells = ""
        HaeAlikansiot "H:\Excel\" ' muuta kansiopolku
        End Sub

        et ole lisännyt viittausta

        Vähän tyhmä kun en tajua mihin tuo viittaus tulee.


      • Repe43
        kunde kirjoitti:

        kuten viestissä mainitaan

        ' lisää referenssi Microsoft Scripting Runtime
        Sub Alikansiot()
        Sheets("Hyperlinkit").Cells = ""
        HaeAlikansiot "H:\Excel\" ' muuta kansiopolku
        End Sub

        et ole lisännyt viittausta

        Menihän se jakeluun pikkuhiljaa missä oli "vika".
        Seuraava kysymys, ensimmäinen alkansio A sarakkeeseen ja sen alikansio B sarakkeeseen jne. Onnistuuko ??


      • Repe43 kirjoitti:

        Menihän se jakeluun pikkuhiljaa missä oli "vika".
        Seuraava kysymys, ensimmäinen alkansio A sarakkeeseen ja sen alikansio B sarakkeeseen jne. Onnistuuko ??

        lisää referenssi Microsoft Scripting Runtime
        Dim rivi As Long
        Sub Alikansiot()
        Sheets("Hyperlinkit").Cells = ""
        HaeAlikansiot "H:"
        JaaAlikansioihin
        Columns("A:IV").AutoFit
        End Sub

        Sub HaeAlikansiot(Kansio As String)

        Dim FSO As Scripting.FileSystemObject
        Dim Lähde As Scripting.Folder
        Dim Alikansio As Scripting.Folder

        Set FSO = New Scripting.FileSystemObject
        Set Lähde = FSO.GetFolder(Kansio)
        rivi = Range("A65536").End(xlUp).Row 1
        Cells(rivi, 1).Formula = Lähde.Path
        Cells(rivi, 1).Hyperlinks.Add Anchor:=Cells(rivi, 1), Address:=Lähde.Path
        For Each Alikansio In Lähde.SubFolders
        HaeAlikansiot Alikansio.Path
        Next Alikansio

        Set Alikansio = Nothing

        Set Lähde = Nothing
        Set FSO = Nothing
        End Sub

        Sub JaaAlikansioihin()
        Dim a As Variant
        Dim i As Long
        Dim j As Integer
        On Error GoTo virhe
        rivi = Range("A65536").End(xlUp).Row
        For i = 136 To rivi
        a = Split(Range("A" & i), "\")
        Cells(i, 1).Hyperlinks.Add Anchor:=Cells(i, 1), Address:=Range("A2") & "\" & a(2)
        For j = 1 To UBound(a)
        If j >= 3 Then
        Cells(i, j - -1).Hyperlinks.Add Anchor:=Cells(i, j - 1), Address:=Cells(i, j - 2) & "\" & a(j)
        End If


        Next
        Next
        virhe:
        End Sub


      • Repe43
        kunde kirjoitti:

        lisää referenssi Microsoft Scripting Runtime
        Dim rivi As Long
        Sub Alikansiot()
        Sheets("Hyperlinkit").Cells = ""
        HaeAlikansiot "H:"
        JaaAlikansioihin
        Columns("A:IV").AutoFit
        End Sub

        Sub HaeAlikansiot(Kansio As String)

        Dim FSO As Scripting.FileSystemObject
        Dim Lähde As Scripting.Folder
        Dim Alikansio As Scripting.Folder

        Set FSO = New Scripting.FileSystemObject
        Set Lähde = FSO.GetFolder(Kansio)
        rivi = Range("A65536").End(xlUp).Row 1
        Cells(rivi, 1).Formula = Lähde.Path
        Cells(rivi, 1).Hyperlinks.Add Anchor:=Cells(rivi, 1), Address:=Lähde.Path
        For Each Alikansio In Lähde.SubFolders
        HaeAlikansiot Alikansio.Path
        Next Alikansio

        Set Alikansio = Nothing

        Set Lähde = Nothing
        Set FSO = Nothing
        End Sub

        Sub JaaAlikansioihin()
        Dim a As Variant
        Dim i As Long
        Dim j As Integer
        On Error GoTo virhe
        rivi = Range("A65536").End(xlUp).Row
        For i = 136 To rivi
        a = Split(Range("A" & i), "\")
        Cells(i, 1).Hyperlinks.Add Anchor:=Cells(i, 1), Address:=Range("A2") & "\" & a(2)
        For j = 1 To UBound(a)
        If j >= 3 Then
        Cells(i, j - -1).Hyperlinks.Add Anchor:=Cells(i, j - 1), Address:=Cells(i, j - 2) & "\" & a(j)
        End If


        Next
        Next
        virhe:
        End Sub

        Syystä tekee saman kun tuo edellinen. Osasinkohan selittä mitä ajan takaa, eli juurikansio A ja sen alla olevat B ja niitten alla olevat C jne.

        A sarakkeessa näkyisi vain H:\Excel
        B sarakkeessa näkyisi Ali1, Ali2, Ali3 jne
        C sarakkeessa näkyisi Aliali1, Aliali2 jne jne

        repe


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Venäjä alkaa iskemään Suomen politiikkaan.

      Tässä on valtion ja koko länsiliiton päämiehet varoitelleet, että Venäjä alkaa talven aikana taas iskemään hybridisesti.
      Sinkut
      135
      765
    2. Muistelen lämmöllä

      Se oli vaikein päätös, jonka olen joutunut tekemään. En pidä valehtelusta, mutta näin sait päätöksen asioille. Rakasti
      Ikävä
      48
      632
    3. Ajattelitko ikinä pyytää anteeksi?

      Tiedät kyllä mistä.
      Ikävä
      70
      619
    4. Tunnistan mun rakkaan

      Kirjoituksen heti kun se on täällä. Mä vaan tiedän sen ja tunnen 🤗
      Ikävä
      81
      561
    5. Miten oletkin noin

      osaamaton kaikin tavoin :)
      Ikävä
      39
      529
    6. Tyrkytät ittees liian

      tasokkaille :)
      Ikävä
      46
      500
    7. Jos olen aiheuttanut pahaa, pyydän anteeksi

      Jos olen omalla kirjoittelullani aiheuttanut täällä jollekin pahaa mieltä tai sotkenut asioita, niin pyydän sitä anteeks
      Ikävä
      64
      489
    8. Uskon, että saataisiin kaikki selvitettyä

      Mutta yhteys on jäissä, minä olen jäässä, enkä osaa tai uskalla enää lähestyä. Se vaan on niin. Naiselta Jos ei ole hyvä
      Ikävä
      36
      465
    9. Odotan tosi paljon et nähdään uudelleen

      Sinussa on piirteitä, jotka sai kiinnostumaan.
      Ikävä
      21
      458
    10. Teinipersu Bergbom lupasi ensimmäisenä euron bensaa

      Teinipersu julkaisi Tiktok-videonsa marraskuussa 2021. Videolla Bergbom viittaa bensan hintoja esittelevään kylttiin ja
      Maailman menoa
      261
      449
    11. Pakko myöntää mies

      En mä aina ihan rehellinen sulle ollut
      Ikävä
      92
      424
    12. Vaihdevuodet ja psykoottinen käytös

      Estrogeenilla on suora yhteys aivojen välittäjäaineisiin, erityisesti serotoniiniin, joka säätelee mielialaa, impulssiko
      Suomussalmi
      36
      401
    13. Timo Vornanen.

      On siinäkin yksi täystampio. Eipä ihme, että persukannattajat sen eduskuntaan äänestikin.
      Maailman menoa
      25
      397
    14. Sofia ja Jeffrey yhdessä

      Sofia julkaisi instassa kuvan hänestä ja Jeffreystä kuvan, taustalla soi Happy birthday biisi ja Jeffrey kasvot peitetty
      Kotimaiset julkkisjuorut
      80
      395
    15. Luottamus

      Luotan vain siihen mitä tapahtuu IRL. Anonyymipalstan vihjailut eivät merkitse minulle mitään.
      Ikävä
      86
      386
    16. Onko se loukkaavaa jos pelkkä seksi kiinnostaa?

      En tiedä olisiko meillä muuta yhteistä edes. En kyllä oikein osaa nähdä meitä menemässä naimisiin, paitsi ehkä jossain U
      Ikävä
      32
      376
    17. Mikä on ollut ihanin

      Kohtaaminen kaivattusi kanssa? Mistä haaveilet hänen kanssaan?
      Ikävä
      13
      375
    18. Kun asiat pitkittyy niin ne mutkistuu

      Mutkaista jo on, ei nämä enää selviä.
      Ikävä
      29
      374
    19. 20
      367
    20. Kangasluoman kirjoitus Lapuan Sanomissa

      Ei voi kun nauraa. Nyt tämä henkilö ajaa säästöjä lakkauttamalla kouluja ja sitä myöten tapetaan sivukyliä. Kyseinen h
      Lapua
      49
      365
    Aihe