欧美性猛交XXXX免费看蜜桃,成人网18免费韩国,亚洲国产成人精品区综合,欧美日韩一区二区三区高清不卡,亚洲综合一区二区精品久久

Sub AutoAddLink()
    Dim strFldPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
    '用戶(hù)選擇指定文件夾
        .Title = '請選擇指定文件夾。'
        If .Show Then strFldPath = .SelectedItems(1) Else Exit Sub
        '未選擇文件夾則退出程序，否則將地址賦予變量strFldPath
    End With
    Application.ScreenUpdating = False
    '關(guān)閉屏幕刷新
    Range('a:b').ClearContents
    Range('a1:b1') = Array('文件夾', '文件名')
    Call SearchFileToHyperlinks(strFldPath)
    '調取自定義函數SearchFileToHyperlinks
    Range('a:b').EntireColumn.AutoFit
    '自動(dòng)列寬
    Application.ScreenUpdating = True
    '重開(kāi)屏幕刷新
End Sub
Function SearchFileToHyperlinks(ByVal strFldPath As String) As String
    Dim objFld As Object
    Dim objFile As Object
    Dim objSubFld As Object
    Dim strFilePath As String
    Dim lngLastRow As Long
    Dim intNum As Integer
    Set objFld = CreateObject('Scripting.FileSystemObject').GetFolder(strFldPath)
    '創(chuàng )建FileSystemObject對象引用
    For Each objFile In objFld.Files
    '遍歷文件夾內的文件
        lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        strFilePath = objFile.Path
        intNum = InStrRev(strFilePath, '\')
        '使用instrrev函數獲取最后文件夾名截至的位置
        Cells(lngLastRow, 1) = Left(strFilePath, intNum - 1)
        '文件夾地址
        Cells(lngLastRow, 2) = Mid(strFilePath, intNum + 1)
        '文件名
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngLastRow, 2), _
                    Address:=strFilePath, ScreenTip:=strFilePath
        '添加超鏈接
    Next objFile
    For Each objSubFld In objFld.SubFolders
    '遍歷文件夾內的子文件夾
        Call SearchFileToHyperlinks(objSubFld.Path)
    Next objSubFld
    Set objFld = Nothing
    Set objFile = Nothing
    Set objSubFld = Nothing
End Function