Excel "A Sütunundaki fotoğrafları xxx klasöründe ara, yyy klasörüne kopyala" Sorunu

[onurtig]

Excel "A Sütunundaki fotoğrafları xxx klasöründe ara, yyy klasörüne kopyala" Sorunu

Merhaba,

Aşağıda ki makroyu evdeki bilgisayarımda çalıştırabiliyorum fakat işyerinde ki makinemde çalıştıramadım dosya yollarını makineye göre düzenledim,

İşin içinden çıkamadım bir hata gözlemliyormusunuz ? Lütfen yardım edin..

VBA Screen Shot ayarların görünmesi açısından: http://prntscr.com/jkkee4


Sub dosyakopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "C:\Users\onurt\Desktop\xxx\"
hedefKlasor = "C:\Users\onurt\Desktop\yyy\"
On Error Resume Next
For i = 1 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & Cells(i, 1).Value & "-1.JPG"
End If
Next i
End Sub

 

[tahsinanarat]

Ekdeki dosya işinizi görecektir

Sub F_Copy()
On Error Resume Next
Dim i%, src$, dest$
Dim ds
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder Range("F1") '("D:\Yeni Klasör")
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder Range("E1") '"D:\Yeni Klasör"
src = Range("I1")
dest = Range("E1") '"D:\Yeni Klasör\"

    For i = 2 To 3200
        FileCopy src & Cells(i, 1) & ".jpg", _
            dest & Cells(i, 1) & ".jpg"
    Next

End Sub

Evvelce böyle bir çalışmam olmuştu, yine bu siteden aldığım yardımlarla hazırladığım dosya ektedir.

http://www.dosya.tc/server13/6kw38o/resimleri_belirtilen_klasore_kopyala.xls.html

vba şifre: 123

 

[onurtig]

Allah razı olsun.. Elleriniz dert görmesin!

Sub F_Copy()
On Error Resume Next
Dim i%, src$, dest$
Dim ds
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder Range("F1") '("D:\Yeni Klasör")
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder Range("E1") '"D:\Yeni Klasör"
src = Range("I1")
dest = Range("E1") '"D:\Yeni Klasör\"

    For i = 2 To 3200
        FileCopy src & Cells(i, 1) & ".jpg", _
            dest & Cells(i, 1) & ".jpg"
    Next

End Sub

Evvelce böyle bir çalışmam olmuştu, yine bu siteden aldığım yardımlarla hazırladığım dosya ektedir.

http://www.dosya.tc/server13/6kw38o/resimleri_belirtilen_klasore_kopyala.xls.html

vba şifre: 123

 

[tahsinanarat]

Allah sizden de razı olsun, güle güle kullan.