Olisi seuraavanlainen ongelma. Pitäisi etsiä tiedostoja kovalevyltä. Tiedostoja on useampi (puhutaan n. 100kpl:sta) ja saisin ne listattuna vaikka exceliin tai johonkin muualle. Niin pystynkö käyttämään tätä listaa hyväksi etsinnässä että saisin kaikki tiedostot kerralla etsittyä?
Etsi toiminto
-Sami-
18724
0Äänestä
Muut lukivat myös
Odottaa vastausta
Näihin keskusteluihin ei ole vielä vastattu. Ole ensimmäinen.
Vastaukset 18
Vanhimmat
windowsin omassa etsi-toiminnossa?
Se vika että sillä saa etsittyä yhden tiedoston kerrallaan. Kun noita etsittäviä olisi yli 100 kpl.
Olisi hiukan nopempaa etsiä noi tiedostot jos saisi kerralla etsittyä ne jonkun listan kautta.
vaan osaa etsiä useampia kerrallaan
laitat siihen hakuun esim:
a*.jpg;b*.txt;c*.doc;...jne
niinpä mutta se hakee kaikki esim a-kirjaimella alkavat jpg-tiedostot mutta jospa en haluakkaan kaikkia tuollaisia tiedostoja vaan puolet niistä.
sinun hakuehtojasi ja tarpeitasi annat tuollai tipoittain?
En jaksa alkaa miettiä että mitähän se vielä tahtoo vaan lopetan tähän.
Koodilla onnistuu. Onko excelin makrot tuttuja? naputin tällaisen koodin exceliä varten. Laita tiedoston nimet eka sarakkeeseen ja aja koodista EtsiTiedostot-makro. Vaatii MS Scrintingin.
Eli lisää koodi excel tiedosoon (työkalut-makro-visual basic editor) ja sieltä vaikka tauluun yksi.
sitten lisäät tuon Microsoft Scripting Runtime kirjaston valitsemalla Tools, References ja Microsoft Scripting Runtime.
Sitten vain ajat koodin, kunhan ensin lisäät tiedostonimet excelin eka sarakkeeseen.
Itse koodi:
Sub EtsiTiedostot()
' lisätään otsikot
With Range("C1")
.Formula = "Löydetyt tiedostot:"
.Font.Bold = True
.Font.Size = 12
End With
Range("C3").Formula = "Polku:"
Range("D3").Formula = "Koko:"
Range("E3").Formula = "Tyyppi:"
Range("F3").Formula = "Luontipvm:"
Range("G3").Formula = "Käytetty viimeksi:"
Range("H3").Formula = "Muokattu viimeksi:"
Range("C3:J3").Font.Bold = True
Dim strPolku As String
strPolku = InputBox("Anna hakemiston polku mistä etsitään", "Polku", "C:\")
ListFilesInFolder strPolku, True
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' käydään hakemiston tiedostot läpi
' esim: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = 4
For Each FileItem In SourceFolder.Files
For i = 1 To Rows.Count
If ActiveSheet.Cells(i, 1) = "" Then Exit For
If FileItem.Name = ActiveSheet.Cells(i, 1) Then
' tiedoston tiedot
Cells(r, 3).Formula = FileItem.Path & FileItem.Name
Cells(r, 4).Formula = FileItem.Size
Cells(r, 5).Formula = FileItem.Type
Cells(r, 6).Formula = FileItem.DateCreated
Cells(r, 7).Formula = FileItem.DateLastAccessed
Cells(r, 8).Formula = FileItem.DateLastModified
r = r 1
End If
Next
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
Kiitos koodista. Hyvin toimii mutta ei ihan minun tarpeisiin.
Pitäisi saada siten että etsisi siten ettei tarvitsisi koko tiedoston nimeä kirjoittaa vaan alku osa riittäisi. Ja lisäksi pitäisi saada tiedosto klikattua linkistä auki.
no helppohan tuo on koodata minkälaiseksi vaan...
tässä versio joka tekee html-sivun jossa on linkit tiedostoihin, ja etsintäkin toimiin tiedostonnimen osalla:
Sub EtsiTiedostot()
' lisätään otsikot
With Range("C1")
.Formula = "Löydetyt tiedostot:"
.Font.Bold = True
.Font.Size = 12
End With
Range("C3").Formula = "Polku:"
Range("D3").Formula = "Koko:"
Range("E3").Formula = "Tyyppi:"
Range("F3").Formula = "Luontipvm:"
Range("G3").Formula = "Käytetty viimeksi:"
Range("H3").Formula = "Muokattu viimeksi:"
Range("C3:J3").Font.Bold = True
Dim strPolku As String
strPolku = InputBox("Anna hakemiston polku mistä etsitään", "Polku", "C:\")
Dim strLinkit As String
strLinkit = InputBox("Anna html-sivun nimi", "Linkit", "c:\filet.htm")
Open strLinkit For Output As #1
Print #1, ""
Print #1, ""
Print #1, "Löydetyt tiedostot"
Print #1, ""
Print #1, ""
Print #1, ""
ListFilesInFolder strPolku, True
Print #1, ""
Print #1, ""
Print #1, ""
Close #1
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' käydään hakemiston tiedostot läpi
' esim: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = 4
For Each FileItem In SourceFolder.Files
For i = 1 To Rows.Count
If ActiveSheet.Cells(i, 1) = "" Then Exit For
If InStr(1, FileItem.Name, ActiveSheet.Cells(i, 1), vbTextCompare) Then
' tiedoston tiedot
Print #1, ""
Print #1, ""
Print #1, "" & FileItem.Path & ""
Print #1, "" & FileItem.Type & ""
Print #1, ""
Cells(r, 3).Formula = FileItem.Path
Cells(r, 4).Formula = FileItem.Size
Cells(r, 5).Formula = FileItem.Type
Cells(r, 6).Formula = FileItem.DateCreated
Cells(r, 7).Formula = FileItem.DateLastAccessed
Cells(r, 8).Formula = FileItem.DateLastModified
r = r 1
End If
Next
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
tuli edellinen hieman huonosti kopioituna, tässä varalta puhdas versio
Sub EtsiTiedostot()
' lisätään otsikot
With Range("C1")
.Formula = "Löydetyt tiedostot:"
.Font.Bold = True
.Font.Size = 12
End With
Range("C3").Formula = "Polku:"
Range("D3").Formula = "Koko:"
Range("E3").Formula = "Tyyppi:"
Range("F3").Formula = "Luontipvm:"
Range("G3").Formula = "Käytetty viimeksi:"
Range("H3").Formula = "Muokattu viimeksi:"
Range("C3:J3").Font.Bold = True
Dim strPolku As String
strPolku = InputBox("Anna hakemiston polku mistä etsitään", "Polku", "C:\")
Dim strLinkit As String
strLinkit = InputBox("Anna html-sivun nimi", "Linkit", "c:\filet.htm")
Open strLinkit For Output As #1
Print #1, ""
Print #1, ""
Print #1, "Löydetyt tiedostot"
Print #1, ""
Print #1, ""
Print #1, ""
ListFilesInFolder strPolku, True
Print #1, ""
Print #1, ""
Print #1, ""
Close #1
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' käydään hakemiston tiedostot läpi
' esim: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = 4
For Each FileItem In SourceFolder.Files
For i = 1 To Rows.Count
If ActiveSheet.Cells(i, 1) = "" Then Exit For
If InStr(1, FileItem.Name, ActiveSheet.Cells(i, 1), vbTextCompare) Then
' tiedoston tiedot
Print #1, ""
Print #1, ""
Print #1, "" & FileItem.Path & ""
Print #1, "" & FileItem.Type & ""
Print #1, ""
Cells(r, 3).Formula = FileItem.Path
Cells(r, 4).Formula = FileItem.Size
Cells(r, 5).Formula = FileItem.Type
Cells(r, 6).Formula = FileItem.DateCreated
Cells(r, 7).Formula = FileItem.DateLastAccessed
Cells(r, 8).Formula = FileItem.DateLastModified
r = r 1
End If
Next
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
jaa näköjään suomi24 muotoileekin väkisin tuota koodia... :( no kerro jos et saa siistittyä toimivaa versiota niin laitan illalla nettisivuilleni mistä voit käydä kopsimassa
tarvitsetko vielä jotain enempi viriteltyä koodia?
Tuossa rivissä missä on se file... Niin siihen tökkää mitä siinä pitäisi lukea?
jos kyse on tästä rivistä:
Print #1, "" & FileItem.Path & ""
niin puolipiste pois nuitten kauttaviivojen ja lainausmerkin jälkeen.
niin ja tuo koodihan ei nyt sitten poista tuplia listasta, jos joku tiedosto löytyy useammalla hakuehdolla. Onko ongelma?
Tuplat eivät ole ongelma.
Eikö tuo etsi kaikki tiedostot esim. jos laittaa listalle tekstin "kuva1" niin se etsii kaikki kuva1 alkavat tiedostot, tiedoston lopusta tai päätteestä riippumatta.
Sitten huomasin ettei se etsi alihakemistoja olisiko sen toteuttaminen ongelma?
Kiitos jo etukäteen!
Tuollaisen version sain tehtyä. Toimii samalla tavalla mutta tekee linkit exceliin. Muttei etsi alihakemistoja!
_______________
Sub EtsiTiedostot()
' lisätään otsikot
With Range("C1")
.Formula = "Löydetyt tiedostot:"
.Font.Bold = True
.Font.Size = 12
End With
Range("C3").Formula = "Polku:"
Range("D3").Formula = "Koko:"
Range("E3").Formula = "Tyyppi:"
Range("F3").Formula = "Luontipvm:"
Range("G3").Formula = "Käytetty viimeksi:"
Range("H3").Formula = "Muokattu viimeksi:"
Range("C3:J3").Font.Bold = True
Dim strPolku As String
strPolku = InputBox("Anna hakemiston polku mistä etsitään", "Polku", "C:\")
ListFilesInFolderDiesel strPolku, True
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' käydään hakemiston tiedostot läpi
' esim: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Dim lPos As Long
Dim sName As String
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = 4
For Each FileItem In SourceFolder.Files
For i = 1 To Rows.Count
If ActiveSheet.Cells(i, 1) = "" Then Exit For
sName = UCase$(FileItem.Name)
lPos = InStr(sName, "_")
If lPos > 0 Then sName = Left$(sName, lPos - 1)
If sName = UCase$(ActiveSheet.Cells(i, 1)) Then
'tiedoston tiedot
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Range("C" & CStr(r)), _
Address:="file://" & FileItem.Path, _
ScreenTip:="Click -> Open Document...", _
TextToDisplay:=FileItem.Path
Cells(r, 4).Formula = FileItem.Size
Cells(r, 5).Formula = FileItem.Type
Cells(r, 6).Formula = FileItem.DateCreated
Cells(r, 7).Formula = FileItem.DateLastAccessed
Cells(r, 8).Formula = FileItem.DateLastModified
r = r 1
End If
Next
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
se taitaa kykllä käydä ne alihakemistotkin läpi mutta tuon r-muuttuja alustuu joka kerralla. Tässä korjattu koodi:
Dim r As Long
Sub EtsiTiedostot()
' lisätään otsikot
With Range("C1")
.Formula = "Löydetyt tiedostot:"
.Font.Bold = True
.Font.Size = 12
End With
Range("C3").Formula = "Polku:"
Range("D3").Formula = "Koko:"
Range("E3").Formula = "Tyyppi:"
Range("F3").Formula = "Luontipvm:"
Range("G3").Formula = "Käytetty viimeksi:"
Range("H3").Formula = "Muokattu viimeksi:"
Range("C3:J3").Font.Bold = True
Dim strPolku As String
strPolku = InputBox("Anna hakemiston polku mistä etsitään", "Polku", "C:\")
r = 4
ListFilesInFolder strPolku, True
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' käydään hakemiston tiedostot läpi
' esim: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
'Dim r As Long
Dim lPos As Long
Dim sName As String
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
'r = 4
For Each FileItem In SourceFolder.Files
For i = 1 To Rows.Count
If ActiveSheet.Cells(i, 1) = "" Then Exit For
sName = UCase$(FileItem.Name)
lPos = InStr(sName, "_")
If lPos > 0 Then sName = Left$(sName, lPos - 1)
If sName = UCase$(ActiveSheet.Cells(i, 1)) Then
'tiedoston tiedot
ActiveSheet.Hyperlinks.Add _
Anchor:=ActiveSheet.Range("C" & CStr(r)), _
Address:="file://" & FileItem.Path, _
ScreenTip:="Click -> Open Document...", _
TextToDisplay:=FileItem.Path
Cells(r, 4).Formula = FileItem.Size
Cells(r, 5).Formula = FileItem.Type
Cells(r, 6).Formula = FileItem.DateCreated
Cells(r, 7).Formula = FileItem.DateLastAccessed
Cells(r, 8).Formula = FileItem.DateLastModified
r = r 1
End If
Next
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
En saannut toimimaan?!
mulla kyllä toimii oikein hyvin. Auttaako jos teet uuden excel tiedoston johon liität tuon koodin?