Potreboval sem makro, ki pregleda datoteke v podani mapi. Če ime datoteke vsebuje določen niz, ustvari novo mapo in datoteke, ki ustrezajo pogoju, prekopira v njo.
Sestavil sem spodnji makro, ki deluje čisto OK.
Prisiljen pa sem bil uporabiti
Koda: Izberi vse
On Error Resume Next
Uporabil pa sem jo zato, ker funkcija Find, če ne najde niza, javi napako.
Celotna koda:
Koda: Izberi vse
Sub PrekopirajDatoteke()
Dim datoteka
Dim MapaInput As String
Dim sporocilo As String
Dim iskano As String
Dim sporocilo_o_iskanju As String
sporocilo = "Vpiši mapo: "
sporocilo_o_iskanju = "Kateri del imena datoteke iščem: "
'vpisovanje mape in iskanega niza
MapaInput = InputBox(sporocilo)
iskano = InputBox(sporocilo_o_iskanju)
datoteka = Dir(MapaInput & "\*.*")
If datoteka = "" Then
'Ce je mapa prazna
MsgBox ("V mapi ni nobene datoteke!")
Else
stevec_kopiranih = 0
stevec_najdenih = 0
' če mapa ni prazna
Do While datoteka <> ""
'če nastopi napaka, nadaljujemo z izvajanjem
On Error Resume Next
Dim ime
ime = datoteka
' potrebujemo za preverjanja obstoja mape in kopiranje datoteke
Set fs = CreateObject("Scripting.FileSystemObject")
' iščemo niz, ob napaki nadaljujemo
najdeno = Application.WorksheetFunction.Find(iskano, ime)
If Err.Number <> 1004 Then 'če številka napake ni 1004
'zgradimo ime izvora in cilja kopiranja
izvor = MapaInput & "\" & ime
cilj = MapaInput & "\" & iskano & "\" '& ime
' če mapa še ni narejena
If fs.folderexists(MapaInput & "\" & iskano) = False Then
MkDir MapaInput & "\" & iskano 'jo naredimo
End If
'če datoteka že obstaja
If fs.FileExists(cilj & ime) Then
stevec_najdenih = stevec_najdenih + 1
Else
stevec_kopiranih = stevec_kopiranih + 1 'povečamo števec
FileCopy izvor, cilj & ime
End If
'fs.CopyFile izvor, cilj, False 'kopiramo, ne prepišemo, če datoteka že obstaja
datoteka = Dir() 'premik na naslednjo datoteko
Else 'če je nastopila pričakovana napaka, gremo na naslednjo datoteko
datoteka = Dir
'MsgBox Err.Number
End If
Loop
End If
' končni izpisi
If stevec_kopiranih = 0 Then
MsgBox "Nobena datoteka ni bila kopirana!" & vbCrLf & _
"Ali so prekopirane že vse datoteke, ali pa ne vsebujejo niza: " & iskano
Else
MsgBox "Število prekopiranih datotek: " & stevec_kopiranih & vbCrLf & _
"Število najdenih v ciljni mapi pred kopiranjem: " & stevec_najdenih
End If
End Sub
