Function kopyala(dosya, kopyala)
Dim fs
Dim KaynakDosya
Dim KopyalanacakYer
Set fs = CreateObject("Scripting.FileSystemObject")
KaynakDosya = dosya
KopyalanacakYer= kopyala
fs.CopyFile KaynakDosya , KopyalanacakYer
Set fs= Nothing
End Function
fonksiyon işini görecektir dostum.
[COLOR=black]
[COLOR=#0000A0]Set[/COLOR] fld = fso.GetFolder(sFol) [COLOR=#0000A0]
For[/COLOR] [COLOR=#0000A0]Each[/COLOR] tFil [COLOR=#0000A0]In[/COLOR] fld.Files [COLOR=#0000A0]
If[/COLOR] Mid(tFil.Name, InStrRev(tFil.Name, ".") + 1) = txtExt [COLOR=#0000A0]Then[/COLOR] _
txtOut = txtOut & fso.BuildPath(fld.Path, tFil.Name) & vbCrLf
txtOut.SelStart = [COLOR=#0000A0]Len[/COLOR](txtOut)
[COLOR=#ff0000] [B]kopyala(fso.BuildPath(fld.Path, tFil.Name), "D:\" & tFil.Name)[/B][/COLOR]
DoEvents [COLOR=#0000A0]
Next[/COLOR][/COLOR]
Çalıştırmadım hata olabilir. Seneler oldu uğraşmayalı. Çalışacaktır muhtemelen