Developing.ru

Код: Выделить всё

Private Sub Example6_Dir()
    Dim iPath$, iFileName$, iRow&, iHyperlinks As Excel.Hyperlinks
    
    iPath = "C:\Мои документы\" 'укажите (или выберите) свою папку
    iFileName = Dir(iPath) 'Dir(iPath & "*.xl*")
    
    If iFileName <> "" Then
       'Application.ScreenUpdating = False
       
       ActiveSheet.Columns(1).Clear
       Set iHyperlinks = ActiveSheet.Hyperlinks
       Do
          iRow = iRow + 1
          iFileName = Dir
          iHyperlinks.Add Cells(iRow, 1), iPath & iFileName, , , "'" & iFileName
       Loop Until iFileName = ""
       
       'Application.ScreenUpdating = True
    End If
End Sub