VBATools

Często spotykam się z tym pytaniem- to tez postanowiłem opublikować na stronie kod, dzięki którym można pobrać nazwy plików określonego w zmiennej katalogu.

Dla tych, którzy chcą posiadać dobrze wykonany dodatek, wzbogacony o inne opcje polecam: Pobierz listę plików

Każda z komórek (począwszy od zaznaczonego miejsca, będzie posiadała nazwę pliku z hiperlinkiem:

Sub Wstawianie_plikow_z_hiperlinkami()
'MVP OShon from VBATools.pl
Dim Buf$, sciezka$, pli$, x&: x = 0
 sciezka = "c:\Temp"
 If Right$(sciezka, 1) <> "" Then sciezka = sciezka & ""
 Buf = Dir(sciezka)
 With Application
 .ScreenUpdating = False
 Do While Len(Buf)
  With .ActiveCell
   Cells(.Row + x, .Column).Value = Buf
   ActiveSheet.Hyperlinks.Add Anchor:=Cells(.Row + x, .Column), _
   Address:=sciezka & Buf, TextToDisplay:=Cells(.Row + x, .Column).Value
  End With
  x = x + 1
  Buf = Dir
 Loop
 .ScreenUpdating = True
 End With
 MsgBox "Pobrano " & x & " pików.", vbInformation, " VBATools.pl"
End Sub

A jak by wyglądał kod, dzieki któremu zapiszemy pliki z katalogami?

Należało by odróżnić katalog od pliku – zapiszemy to w pierwszej kolumnie począwszy od zaznaczonej komórki:

Sub czytaj_Pliki_z_katalogami_FSO()
 Dim objFSO As Object 'Scripting.FileSystemObject
 Dim objFolder As Object 'Scripting.Folder
 Dim objFile As Object 'Scripting.File
 Dim oSf As Object 'Scripting.Subfolders
 Dim objDir As Object 'Scripting.File

 Const strFolderPAth As String = "C:\Temp"

 Dim x&
 Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")
 Set objFolder = objFSO.GetFolder(strFolderPAth)
 Set oSf = objFolder.SubFolders

 With ActiveCell
 For Each objDir In oSf
 With Cells(.Row + x, .Column)
  .value = "DIR"
  .Offset(, 1) = objDir.name
  ActiveSheet.Hyperlinks.Add Anchor:=.Offset(, 1), _
  Address:=objDir.path, TextToDisplay:=objDir.name
  x = x + 1
 End With
 Next
 For Each objFile In objFolder.Files
  With Cells(.Row + x, .Column)
   .value = "File"
   .Offset(, 1) = objFile.name
   ActiveSheet.Hyperlinks.Add Anchor:=.Offset(, 1), _
   Address:=objFile.path, TextToDisplay:=objFile.name
   x = x + 1
  End With
 Next
 End With

 Set objFSO = Nothing
 Set objFolder = Nothing
 Set oSf = Nothing
End Sub

I dalej idąc jak katalogi z plikami i podkatalogami?

Sub czytaj_Wszystkie_Pliki_z_katalogami_FSO()
 Dim objFSO As Object 'Scripting.FileSystemObject
 Dim objFolder As Object 'Scripting.Folder
 Dim objFile As Object 'Scripting.File
 Dim objDir As Object 'Scripting.File

 Const strFolderPAth As String = "C:\Temp"

 Dim x&
 Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")
 Set objFolder = objFSO.GetFolder(strFolderPAth).SubFolders

 With ActiveCell
 For Each objDir In objFolder
 With Cells(.Row + x, .Column)
  .Value = "Dir"
  .Offset(, 1) = objDir.Name
  ActiveSheet.Hyperlinks.Add Anchor:=.Offset(, 1), _
  Address:=objDir.Path, TextToDisplay:=objDir.Name
 End With
 x = x + 1
 For Each objFile In objDir.Files
  With Cells(.Row + x, .Column)
   .Value = "File"
   .Offset(, 1) = objFile.Name
   ActiveSheet.Hyperlinks.Add Anchor:=.Offset(, 1), _
   Address:=objFile.Path, TextToDisplay:=objFile.Name
   x = x + 1
  End With
 Next
 Next
 End With

 Set objFSO = Nothing
 Set objFolder = Nothing
End Sub

(c) Shon Oskar – www.VBATools.pl