Sutunda belirtilen dosyaları taşıma

[tahsinanarat]

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) & ".pdf", _
dest & Cells(i, 1) & ".pdf"
Next

End Sub

ekli dosyada yukarıda ki kod ile a sütununda belirtilen dosyaları kaynak sutundan hedef sutuna kopyasını alabiliyorum.
Buraya kadar herhangi bir sıkıntı yok.

Ancak ben kopya almak yerine dosyayı taşımak istiyorum. FileCopy src yi FileMove src olarak değiştiriyorum, ancak taşıma işlemi yapmıyor FileMove src sarıya boyanıp hata mesajı veriyor.

Taşımam için nasıl bir değişiklik yapmalıyım. Yardımcı olacak arkadaşlarıma şimdiden teşekkür ederim.

 

[ÖmerBey]

Merhaba,
FileCopy yerine ds.MoveFile kullanabilirsiniz.
Alternatif olarak Name komutu da kullanılabilir.

Name src & Cells(i, 1) & ".pdf" as dest & Cells(i, 1) & ".pdf"

 

[igultekin2000]

Kopyalama işlemi uzun zamandır düşündüğüm işlemdi, çok işime yaradı. iyi çalışmalar.

 

[tahsinanarat]

Sn. Ömer Bey, cevabınız için çok teşekkür ediyorum, ds.FoveFile kullandım döngü devam ediyor excel yanıt vermiyor şeklinde,
ikincisini de
FileCopy src & Cells(i, 1) & ".pdf", _
dest & Cells(i, 1) & ".pdf"
satırını kahdırıp yerine koydum denedim yine sonuç alamadım. Bilginize.

 

[halit3]

Bu kodu bir dene

Sub F_Copy()

Dim eski As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2 

For i = 2 To 3200
yeni = src & Cells(i, 1) & ".pdf"
eski = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(eski) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
FileCopy eski, yeni
'Name eski As yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

Next

End Sub

 

[tahsinanarat]

Sn. Halit hocam, cevap için çok teşekkür ediyorum ancak kopyalama değil, taşıma yapmak istiyoruz.

 

[ÖmerBey]

Tekrar merhaba,
Anladığım kadarıyla hata almadınız, ama kod döngüde kilitlendi kaldı. Bu dosya sayınızın fazlalığından olabilir. İlk mesajda yazdığınız kodlardaki yol ve dosya isimleri doğruysa önerdiğim kodların düzgün çalışması gerekiyor.
Dosya sayınız fazla olduğu için kilitlenme yapıyorsa adım adım gittiğinizde düzgün çalışacaktır. F8 ile adım adım ilerleyerek kodun çalışmasını izler misiniz?
Farklı bir hata alırsanız lütfen belirtiniz.

 

[tahsinanarat]

Sn. ÖmerBey; kopyalama kodlarında dosya ne kadar olursa olsun hemen kopyalama yapıyor, ancak taşıma da bir kişi dahi taşımak istediğimde excel yanıt vermiyor şeklinde uzun süren bir döngüye giriyor.

 

[halit3]

Sn. Halit hocam, cevap için çok teşekkür ediyorum ancak kopyalama değil, taşıma yapmak istiyoruz.

taşıma içinde kod yazılı siz aktif etmeniz gerekiyor.
kopyalanak için bu

FileCopy eski, yeni

taşımak için bu

Name eski As yeni

 

[ÖmerBey]

kopyalama yapıyor, ancak taşıma da bir kişi dahi taşımak istediğimde excel yanıt vermiyor

O halde daha önceki kodlarınızla önce kopyalayıp sonra kopyaladığınız dosyayı silerseniz, taşıma yapmakla aynı sonuca varır.

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

 

[halit3]

kopyalamak için kod

Sub F_Copy()

Dim eski As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2

For i = 2 To 3200
yeni = src & Cells(i, 1) & ".pdf"
eski = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(eski) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
FileCopy eski, yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

Next

End Sub

taşımak için kod

Sub F_Copy()

Dim eski As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2

For i = 2 To 3200
yeni = src & Cells(i, 1) & ".pdf"
eski = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(eski) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
Name eski As yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

Next

End Sub

 

[tahsinanarat]

Sn. Halit hocam 'Name eski As yeni pasif olarak görmüştüm ama hiç aklıma gelmedi denemek. istediğim sonucu ulaştım elinize sağlık,
Sn. ÖmerBey sizede çok teşekkür ediyorum, belirttiğiniz şekilde de iş görüyor, önce kopyalayıp sonra silmesi, bu kodunuzu da arşiv kayıtlarıma alıyorum. Hepinize hayırlı geceler diliyorum.

 

[halit3]

Sn. Halit hocam 'Name eski As yeni pasif olarak görmüştüm ama hiç aklıma gelmedi denemek. istediğim sonucu ulaştım elinize sağlık,
Sn. ÖmerBey sizede çok teşekkür ediyorum, belirttiğiniz şekilde de iş görüyor, önce kopyalayıp sonra silmesi, bu kodunuzu da arşiv kayıtlarıma alıyorum. Hepinize hayırlı geceler diliyorum.

Teşekkürler iyi çalışmalar

 

[tahsinanarat]

Sn. Halit hocam ilk boşluğa kadar olan rakamlar sicil oluyor, her sicil bir kişiyi temsil ediyor bunlar şimdilik 3 yada 4 rakamdan oluşmaktadırlar,
A sütununda saadece sicil yazarak kopyalama veya taşıma yapmak istersek kodda nasıl bir değişiklik yapmalıyız, bu konuda da yardımcı olabilirmisiniz.
585-TAHSİN ANARAT değilde
585 olarak dosya içindeki 585-TAHSİN ANARAT, 585-K1 şeklinde olan dosyaları taşımak için

 

[halit3]

Ben bir şey anlamadım