VBATools

Lista plików z hiperlinkami do ich uruchomienia

by on Jul.04, 2011, under Excel, Porady

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

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała