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

721

    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. Vilma Nissinen pyytää anteeksi rasistisia lausuntojaan

      Nöyrtyi kuten persut yleensäkin. On kyllä noloa tuollainen vätystely, kun ei ole miestä seisoa omien lausuntojensa takan
      Maailman menoa
      165
      2987
    2. Riikka Purra: "Kokoomus haluaa leikata pienituloisten etuuksista - Se ei meille käy"

      Näin vakuutti persujen Purra edellisten eduskunta vaalien alla,. https://www.ku.fi/artikkeli/4910942-kun-uudessa-videos
      Maailman menoa
      61
      1909
    3. Lindtmanin pääministeriys lähenee päivä päivältä

      Suomen kansan kissanpäivät alkavat siitä hetkestä, kun presidentti Stubb on tehnyt nimityksen. Ainoastaan ylin tulodesi
      Maailman menoa
      65
      1533
    4. Sandels tölkin hinta nousi 1,29 eurosta 1,32 euroon

      Mitähän järkeä valtiolla on verottaa tuotakin elintarviketta niin kovasti, että on järkevämpää käydä hakemassa ulkomailt
      Köyhyys
      29
      1520
    5. Oon kyllä välillä ollut susta

      Nainen huolissani, en oo niin sydämetön mitä tunnut ajattelevan
      Ikävä
      90
      1216
    6. Tuntuuko sinusta mies

      että olet jossain, mutta sydämessäsi haluat olla muualla. Suunnittelet kaikkea kivaa ja olet innolla mukana, mutta silti
      Ikävä
      22
      1195
    7. Rakastan sitä

      kun uppoat selittämään jotain. Etsit oikeaa tapaa sanoa jotain, jonka olet jo etukäteen miettinyt, sekoat vähän sanoissa
      Ikävä
      49
      953
    8. Jokaisella tytöllä on supervoimansa

      Millaisia ajatuksia artikkeli herättää? Mainos: Dove | ”Itsetuntoni oli ihan romuttunut” – Peppina Rosén haastaa tavan
      Sinkut
      186
      883
    9. Ikävä uutinen uudesta Unelmia Italiassa kaudesta - Iso pettymys tv-katsojille!

      Unelmia Italiassa -sarja kertoo Ellen Jokikunnaksen perheen elämästä Suomessa ja Italiassa. Nyt Ellen on kertonut tuleva
      Tv-sarjat
      5
      882
    10. Mitä tapahtuisi....

      Meidän välillä jos törmäisimme yöelämässä ilman häiriötekijöitä ja olisimme hieman huppelissa? Päättyisikö ilta kenties
      Ikävä
      60
      869
    Aihe