¡ÚVBA¡Û¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¥·¡¼¥È¤Ëɽ¼¨¤¹¤ë

0

    ¡ãµ¡Ç½¡ä
    ¡Ê£±¡Ë¥Õ¥¡¥¤¥ë°ìÍ÷(¥µ¥Ö¥Õ¥©¥ë¥À¤ò´Þ¤à)¤ò¼èÆÀ¤·¤Æ¥·¡¼¥È¤Ëɽ¼¨¤·¤Þ¤¹
    ¡Ê£²¡Ë¥µ¥Ö¥Õ¥©¥ë¥À¤ÏºÆµ¢Åª¤ËÆɤ߹þ¤ß¤Þ¤¹

     

    ¡ã¥¤¥á¡¼¥¸¡ä

     

    VBA.¥Õ¥¡¥¤¥ë°ìÍ÷,¥µ¥Ö¥Õ¥©¥ë¥À,CreateObject,


    ¡ã»È¤¤Êý¡ä
    °ìÈÖ´Êñ¤Ê¤Î¤ÏThisWorkbook¤Ë¤½¤Î¤Þ¤ÞÄ¥¤êÉÕ¤±¤Æ¤¯¤À¤µ¤¤
    ¿§¡¹¥¢¥ì¥ó¥¸¤·¤Æ¤âÌÌÇò¤¤¤È»×¤¤¤Þ¤¹
     

    '//¥ï¡¼¥¯¥Ö¥Ã¥¯¥ª¡¼¥×¥ó¤Ç¥Õ¥©¥ë¥ÀÁªÂò¥À¥¤¥¢¥í¥°¤òɽ¼¨
    Private Sub Workbook_Open()
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                ¥Õ¥¡¥¤¥ë°ìÍ÷ .SelectedItems(1)
            End If
        End With
    End Sub

    '//ÁªÂò¤µ¤ì¤¿¥Õ¥©¥ë¥À¤Î¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ¤¹¤ë¥×¥í¥·¡¼¥¸¥ã¤ò¥³¡¼¥ë
    Sub ¥Õ¥¡¥¤¥ë°ìÍ÷(ByVal folpath As String)    
        'Á´¤Æ(¿ô¼°¡¢Ê¸»úÎó¡¢½ñ¼°¡¢¥³¥á¥ó¥È¡¢¥¢¥¦¥È¥é¥¤¥ó)¥¯¥ê¥¢
        Cells.Select
        Selection.Clear
        'Îó¤ÎÉý¡¢¥Õ¥©¥ó¥È¥µ¥¤¥º¤ò¥»¥Ã¥È
        Selection.ColumnWidth = 4
        Selection.Font.Size = 9
        Range("A1").Select
        '¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¥µ¥Ö¥Õ¥©¥ë¥À¤Þ¤Ç¼èÆÀ¤·¤Æɽ¼¨¤¹¤ë
        Application.ScreenUpdating = False
        Call ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(folpath, 1, 0)
        Application.ScreenUpdating = True
        '½ªÎ»¥á¥Ã¥»¡¼¥¸
        MsgBox "¤ª¤ï¤ê¤Þ¤·¤¿", vbInformation
    End Sub

    '//¥Õ¥¡¥¤¥ë°ìÍ÷¤òºÆµ¢Åª¤Ë¼èÆÀ¤·¤Æ¥·¡¼¥È¤Ëɽ¼¨¤¹¤ë
    '//°ú¿ô¡¡gyo¡§½ÐÎϳ«»Ï¹ÔÈÖ¹æ
    '//¡¡¡¡¡¡clm¡§½ÐÎϳ«»ÏÎóÈÖ¹æ(1ÎóÌܤ«¤é¤ÎÁêÂÐÃÍ)

    Sub ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(ByVal folpath As String, ByRef gyo As Long, ByVal clm As Integer)
        Dim buf As String
        Dim fol As Object
        '¥ë¡¼¥È¥Õ¥©¥ë¥À¤òɽ¼¨
        Cells(gyo, 1) = "¡Ú" & CStr(gyo) & "¡Û"
        Cells(gyo, 2 + clm) = folpath
        gyo = gyo + 1
        '¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ
        buf = Dir(folpath & "¥*.*", vbNormal)
        Do While buf <> ""
            Cells(gyo, 1) = "¡Ú" & CStr(gyo) & "¡Û"
            Cells(gyo, 2 + clm) = "­ø"
            Cells(gyo, 2 + clm + 1) = buf
            gyo = gyo + 1
            buf = Dir()
        Loop
        '¥µ¥Ö¥Õ¥©¥ë¥À¤«¤é¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ
        With CreateObject("Scripting.FileSystemObject")
            For Each fol In .getFolder(folpath).SubFolders
                Call ¥Õ¥¡¥¤¥ë°ìÍ÷¤ò¼èÆÀ(fol.Path, gyo, clm + 1)
            Next fol
        End With
    End Sub

     

    ¤è¤í¤·¤±¤ì¤Ð¥Ý¥Á¥Ã¤È²¡¤·¤Æ¤¯¤À¤µ¤¤

    ¥×¥í¥°¥é¥Þ¡¼ ¥Ö¥í¥°¥é¥ó¥­¥ó¥°¤Ø



    selected entries

    categories

    calendar

    S M T W T F S
         12
    3456789
    10111213141516
    17181920212223
    24252627282930
    31      
    << March 2024 >>

    profile

    others

    archives