Sub select_Click()

    Dim sheetA As Worksheet
    Dim Shell, myPath

    Set sheetA = ActiveSheet


    Set Shell = CreateObject("Shell.Application")
    Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10)

    If Not myPath Is Nothing Then
        sheetA.Cells(3, 2).Value = myPath.Items.Item.path
    End If

    Set Shell = Nothing
    Set myPath = Nothing

End Sub


Sub copy_Click()
    Dim sheetA As Worksheet
    Dim strNow As String
    Dim cnt As Long
    Dim i As Long

    cnt = 0
    Set sheetA = ActiveSheet

    For i = 7 To 60000
        If sheetA.Cells(i, 2).Value = "" Then
            cnt = i - 1
            Exit For
        End If
    Next i

    strNow = Format(Now, "yyyymmdd_hhnnss")

    Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = strNow
    Set sheetDeki = Sheets(strNow)

    sheetA.Range("A7:F" & i).Copy sheetDeki.Range("A1:F" & (i - 6))

    sheetDeki.Columns(1).ColumnWidth = 7
    sheetDeki.Columns(2).ColumnWidth = 60
    sheetDeki.Columns(3).ColumnWidth = 30
    sheetDeki.Columns(4).ColumnWidth = 20
    sheetDeki.Columns(5).ColumnWidth = 10
    sheetDeki.Columns(6).ColumnWidth = 20

End Sub

Sub clear_Click()

    Dim sheetA As Worksheet

    Set sheetA = ActiveSheet

    Call clearAll(sheetA)

    MsgBox "クリアしました"

End Sub

Private Function clearAll(sheetA As Worksheet)

    Dim cnt As Long
    Dim i As Long


    cnt = 0

    For i = 7 To 60000

        If sheetA.Cells(i, 2).Value = "" Then

            cnt = i - 1
            Exit For
        End If
    Next i

    sheetA.Range(Cells(8, 1), Cells(i, 6)).Clear

    Application.DisplayAlerts = False

        If ExistsWorksheet("参照不可フォルダ") Then
            Sheets("参照不可フォルダ").Delete
        End If
    Application.DisplayAlerts = True

End Function




Sub ref2_Click()

End Sub
Sub serach3_Click()

    Dim sheetA As Worksheet
    Dim sheetNG As Worksheet
    Dim path As String
    Dim cnt As Long
    Dim errCnt As Long
    Dim fso As Object

    cnt = 0
    errCnt = 2

    Set sheetA = ActiveSheet

    Call clearAll(sheetA)

    Worksheets.Add(Before:=Worksheets(1)).name = "参照不可フォルダ"
    Set sheetNG = Sheets("参照不可フォルダ")

    sheetNG.Cells(1, 1).Value = "参照不可フォルダ"

    sheetA.Activate

    path = sheetA.Cells(3, 2).Value

    Set fso = CreateObject("Scripting.FileSystemObject")

    Call search(fso, sheetA, sheetNG, path, cnt, errCnt)

    If errCnt = 2 Then
        Application.DisplayAlerts = False
        Sheets("参照不可フォルダ").Delete
        Application.DisplayAlerts = True
        sheetA.Activate
    End If

    MsgBox "検索が完了しました"

End Sub

Sub search(fso As Object, sheetA As Worksheet, sheetNG As Worksheet, path As String, cnt As Long, errCnt As Long)

    Dim folderObj As Object

    If cnt > 60000 Then

        MsgBox "検索対象が60000件を超えています"
    Else
        On Error GoTo ErrLabel

        Set folderObj = fso.GetFolder(path)



        For Each objFILE In folderObj.Files
            cnt = cnt + 1

            With objFILE
                sheetA.Cells(cnt + 7, 1).Value = cnt
                sheetA.Cells(cnt + 7, 2).Value = .ParentFolder
                sheetA.Cells(cnt + 7, 3).Value = .name
                sheetA.Cells(cnt + 7, 4).Value = .Type
                sheetA.Cells(cnt + 7, 5).Value = .Size
                sheetA.Cells(cnt + 7, 6).Value = .DateLastModified

            End With


        Next objFILE


        For Each objPATH2 In folderObj.SubFolders

            Call search(fso, sheetA, sheetNG, objPATH2.path, cnt, errCnt)
        Next objPATH2

    End If

    Exit Sub

ErrLabel:
    If Not (folderObj Is Nothing) Then
        sheetNG.Cells(errCnt, 1).Value = folderObj.path
    Else
        sheetNG.Cells(errCnt, 1).Value = path & "存在しない"
    End If
    errCnt = errCnt + 1
    sheetA.Activate
End Sub

Private Function ExistsWorksheet(ByVal name As String)

    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.name = name Then
            ' 存在する
            ExistsWorksheet = True
            Exit Function
        End If
    Next

    ' 存在しない
    ExistsWorksheet = False
End Function