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

716

    Vastaukset

    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


      • 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. Ihanasti alkoi aamu: SDP:n kaula kokoomukseen jo 6,9 %-yks

      Lindtmanin I hallitus on tukevasti jytkyttämässä laittamaan Suomi kuntoon Orvon täystuhohallituksen jäljiltä, jonka kann
      Maailman menoa
      544
      3666
    2. Minkä ikäinen

      Minkä ikäinen on kaipauksesi kohde?
      Ikävä
      171
      2680
    3. Teidän persujen pitäisi välillä miettiä kuinka Suomen talous saataisiin kuntoon

      Ja lopettaa tuo tyhjänpäiväinen maahanmuuttajista höpöttäminen. Teillä on sentään rahaministerin salkku tällä kierroksel
      Maailman menoa
      185
      2610
    4. Persujen VigeIius noIasi taas itsensä

      Kun uhriutui vuonna 2024 (siis persujen "vahtivuorolla") Tampereella aloittaneen perheryhmäkodin toiminnasta. ”Leviää k
      Maailman menoa
      19
      2124
    5. Persut ei kestä heidän johtajistaan tehtyä huumoria

      Laajalti tiedostettu tosiasia on, että autoritaariset johtajat ja erinäiset diktaattorit eivät kestä heidän kustannuksel
      Maailman menoa
      48
      1960
    6. Kuka omistaa entisen Veljeskodin?

      Kenellä on varaa pitää hiljattain remontoitua rakennusta tyhjillään? Tehdäänkö siitä Suomen kallein kirpputori vai mikä
      Ähtäri
      8
      1892
    7. Vasemmistoliitto peruisi sosiaaliturvan heikennykset

      He palauttaisivat työttömyysturvan ja asumstuen suojaosat, eli saisi jälleen tienata 300 euroa kuukaudessa ilman tukien
      Maailman menoa
      39
      1615
    8. Martina ei mennyt naimisiin

      IS 17.9: Martinan häät peruuntui, tajusi, ettei ollut oikea aika. Rahat meni hevosiin. On edelleen parisuhteessa Yhdysva
      Kotimaiset julkkisjuorut
      183
      1563
    9. Kaninkolojen vaikutus?

      Vinkki sinkkumiehille: jos haluatte kunnollisen täysijärkisen naisen, niin kaivautukaa ulos kaninkoloistanne ja parantak
      Sinkut
      217
      1556
    10. Kuka opettaja, mikä koulu

      Minkä koulun opettaja saanut potkut
      Nivala
      14
      1456
    Aihe