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

713

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      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 ??

      • kunde
        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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Laitetaas nyt kirjaimet tänne

      kuka kaipaa ja ketä ?
      Ikävä
      153
      11021

    2. Pieni häivähdys sinusta

      Olet niin totinen
      Ikävä
      53
      5269

    3. Taas ryssittiin oikein kunnolla

      r….ä hyökkäsi Viroon sikaili taas ajattelematta yhtään mitään https://www.is.fi/ulkomaat/art-2000011347289.html
      NATO
      45
      2473

    4. Missä olet ollut tänään kaivattuni?

      Ikävä sai yliotteen ❤️ En nähnyt sua tänään söpö mies
      Ikävä
      31
      2169

    5. Vanha Suola janottaa Iivarilla

      Vanha suola janottaa Siikalatvan kunnanjohtaja Pekka Iivaria. Mies kiertää Kemijärven kyläjuhlia ja kulttuuritapahtumia
      Kemijärvi
      13
      1731

    6. Valtimon Haapajärvellä paatti mäni nurin

      Ikävä onnettomuus Haapajärvellä. Vene hörpppi vettä matkalla saaren. Veneessä ol 5 henkilöä, kolme uiskenteli rantaan,
      Nurmes
      42
      1594

    7. Tiedän kuka sinä noista olet

      Lucky for you, olen rakastunut sinuun joten en reagoi negatiivisesti. Voit kertoa kavereillesi että kyl vaan, rakkautta
      Ikävä
      31
      1280

    8. Känniläiset veneessä?

      Siinä taas päästiin näyttämään miten tyhmiä känniläiset on. Heh heh "Kaikki osalliset ovat täysi-ikäisiä ja alkoholin v
      Nurmes
      35
      1206

    9. Daniel Nummelan linjapuhe 2025

      Kansanlähetyksen toiminnanjohtajan Daniel Nummelan linjapuhe tänään. Rehellistä analyysiä mm. evlut kirkosta ja piispo
      Luterilaisuus
      98
      952

    10. Tulemmeko hyvin

      Toimeen ja juttuun keskenämme? Luulen, että sopisit hyvin siihen ☀️ympäristöön, paljon kaikkea erilaista.♥️mietin tätä s
      Ikävä
      6
      916
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt