• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile klasörden klasöre yada emaili dosya kopyalama.

M

mustilem23

Katılım
29 Ekim 2010
Mesajlar
365
Excel Vers. ve Dili
Microsoft Office 365 ProPlus 64 bit
Makro kodları ile bir klasörden başka bir kalasöre yada emaili dosya kopyalama işlemi yapmak mümkün müdür kopyalanacak belgelerin türü pdf tir .

bir excel sayfasının 1 sutununa alt alta gelecek şekilde 100 adet sayı kopyalayacağım ,makrodan beklentim bu yüz sayıyı gösterdiğim klasörde bulup başka bir kalasöre kopyalamak yada direk email sayfanı yüklemek istiyorum yardımımcı olabilir misiniz .
 
mustilem23' Alıntı:
Makro kodları ile bir klasörden başka bir kalasöre yada emaili dosya kopyalama işlemi yapmak mümkün müdür kopyalanacak belgelerin türü pdf tir .

bir excel sayfasının 1 sutununa alt alta gelecek şekilde 100 adet sayı kopyalayacağım ,makrodan beklentim bu yüz sayıyı gösterdiğim klasörde bulup başka bir kalasöre kopyalamak yada direk email sayfanı yüklemek istiyorum yardımımcı olabilir misiniz .
Genişletmek için tıkla ...

Önceki konudaki sorunuzu kopyalayıp buraya yapıştırmışsınız.
Bizden ne yapmamızı istiyorsunuz.Örnek dosyanız yok ve kopyalanacak dosyaların yolları yok hangi dosyalar kopyalanacak.?

Bunları bizim bilmemiz mümkün değil bu şekildede size yardımcı olamam.
 
Evet haklısınız Halit Bey ,

resimde belirtmiş olduğum klasörde bulunan pdf dosyaları içinde excel sutununa yazdığım kodları bulup ayrı bir kalasöre kopyalamak istiyorum makro ile.


http://c1206.hizliresim.com/y/f/7vng6.gif
 

Ekli dosyalar

Sub dasyakopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "C:\Documents and Settings\admin\Desktop\Yeni Klasör\" ' buraya var olan dosya yolunu yazacaksınız.
hedefKlasor = "C:\Documents and Settings\admin\Desktop\DENEME\" 'buraya kaopyalıyacağınız klasörün yolunu yazacaksınız.
On Error Resume Next
For i = 1 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value
If CreateObject("Scripting.FileSystemObject").FileExi sts(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & Cells(i, 1).Value
End If
Next i
End Sub
 
ekli dosyı kendinize uyarlayınız

Kaynak dosya, hedef dosya ve dosya uzantısını (başına nokta koyarak) ilgili hücrelere girip deneyiniz.
Sub F_Copy()
On Error Resume Next
Dim i%, src$, dest$
Dim ds
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder Range("F1")
Set ds = CreateObject("Scripting.FileSystemObject")
ds.CreateFolder Range("E1")
src = Range("I1")
dest = Range("E1")
For i = 2 To 3200
FileCopy src & Cells(i, 1) & Range("k1"), _
dest & Cells(i, 1) & Range("k1")
Next
End Sub


Not: kodlar evvelce bu siteden temin edilmiştir.
 

Ekli dosyalar

Son düzenleme:
Halit Bey ,

Verdiğininiz kodları çalıştırmaya çalıştım fakat resimdeki gibi bir hata alıyorum makro konusunda yenıyım ,yardımcı olabilir iseniz çok sevinirim.

http://c1206.hizliresim.com/y/g/7wq68.gif

veri yolları aşağıdaki gibidir .

veriKlasor = "C:\Users\MDOGRU\Desktop\TEKNİK RESİMLER KOMPLE\"
hedefKlasor = "C:\Users\MDOGRU\Desktop\satınalma\" '

Tahsin Bey ,

eklemiş olduğunuz dosyayı inceledim tam aradığım gibi bir şey sanırım onuda çalıştıramıyorum sanırım oda office 2007 kullandığımdan kaynaklanıyor yardımcı olabilir seniz çok sevinirim
 
Office 2007 kullanmadım ama sanırım açıldıktan sonra makroları aktif etmeniz gerekiyor.
 
mustilem23' Alıntı:
Halit Bey ,

Verdiğininiz kodları çalıştırmaya çalıştım fakat resimdeki gibi bir hata alıyorum makro konusunda yenıyım ,yardımcı olabilir iseniz çok sevinirim.

http://c1206.hizliresim.com/y/g/7wq68.gif

veri yolları aşağıdaki gibidir .

veriKlasor = "C:\Users\MDOGRU\Desktop\TEKNİK RESİMLER KOMPLE\"
hedefKlasor = "C:\Users\MDOGRU\Desktop\satınalma\" '

Tahsin Bey ,

eklemiş olduğunuz dosyayı inceledim tam aradığım gibi bir şey sanırım onuda çalıştıramıyorum sanırım oda office 2007 kullandığımdan kaynaklanıyor yardımcı olabilir seniz çok sevinirim
Genişletmek için tıkla ...

öncelikle herhalde sayfa üzerinde dosya uzantıları mevcut değil kodu yeniden güncelledim.

sizin hata aldığınız bölüm "FileExi sts" bu
bunun arasındaki boşluğu silin "FileExists"

Bu kodları boş bir madüle yapıştırın ve bir makro komut düğmesine bağlayın siz sayfanın modülüne yapıştırmışsınız.


Kod: 
Sub dasyakopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "C:\Users\MDOGRU\Desktop\TEKNİK RESİMLER KOMPLE\"
hedefKlasor = "C:\Users\MDOGRU\Desktop\satınalma\"
On Error Resume Next
For i = 1 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value & ".pdf"
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & Cells(i, 1).Value & ".pdf"
End If
Next i
End Sub
 
yarın bir deneyim halit bey şirketten resmen siteyi engellediler :) bunları sizin bir excele kaydedip gönderme şansınız varmıdır bu bağlama işini nasıl yapacağımı pek bilmiyotum da daha doğrusu bu vermiş olduğunuz kodları nereye ve nasıl kullanacagımı bılmıyorum .
 
halit bey çok teşekkür ederim verdiğiniz son excell çalıştı .aynı konu ile bir ricam daha olsa klasörde bulamadığı kodları hedef klasörde bir excel sayfasın da sıralaması mümkün müdür ?
 
halit Bey bulamadığı kodları nasıl gösterebilirz çünkü 150 civarı teknik resim kopyalıyor klasore ama saymak ve hangısı eksık bulmak cok zor yardımcı olabilirseniz çok memnun kalırım bulamadığını exlde işaretlese yada farklı bir metod düşünebilir miyiz.
 
üstadlar bu konuya bir el atabilirmiyiz halit usta sanırım tatile çıktı :)
 
mustilem23' Alıntı:
halit Bey bulamadığı kodları nasıl gösterebilirz çünkü 150 civarı teknik resim kopyalıyor klasore ama saymak ve hangısı eksık bulmak cok zor yardımcı olabilirseniz çok memnun kalırım bulamadığını exlde işaretlese yada farklı bir metod düşünebilir miyiz.
Genişletmek için tıkla ...

Kod :

Olmayan dosyalara ait hücre kırmızı renkle belirtiliyor
 

Ekli dosyalar

Halit bey ilginiz için çok teşekkür ederim çok kullanışlı bir çalışma oldu ellerinize sağlık ,son olarak bu konu ile ilgili bir sorum olacak kopyalamayı direk email sayfasının içine ekletme gibi bir imkan olur mu ?.
 
mustilem23' Alıntı:
Halit bey ilginiz için çok teşekkür ederim çok kullanışlı bir çalışma oldu ellerinize sağlık ,son olarak bu konu ile ilgili bir sorum olacak kopyalamayı direk email sayfasının içine ekletme gibi bir imkan olur mu ?.
Genişletmek için tıkla ...

email ile ilgili bilgim yok bunun için yeni bir başlık altında farklı bir konu açarak sorunuzu sorun.
 
Halit Bey ,

iyi günler yapmış olduğunuz makrolu dosyayı kullanıyor çok işime yarıyor fakat şuan şirket yeni bir yapılanmaya gitti ağda 1 klasör içinde paylaşıyor resimleri fakat ben veri klasörünün yer imini değiştiriyorum fakat makro çalışmıyor yardımcı olabilir misiniz.

veri klasörümün adresi aşağıdaki gibidir.

\\durmaarge\ARGE_DAGITIM\SERI_MAKINELER
 
mustilem23' Alıntı:
Halit Bey ,

iyi günler yapmış olduğunuz makrolu dosyayı kullanıyor çok işime yarıyor fakat şuan şirket yeni bir yapılanmaya gitti ağda 1 klasör içinde paylaşıyor resimleri fakat ben veri klasörünün yer imini değiştiriyorum fakat makro çalışmıyor yardımcı olabilir misiniz.

veri klasörümün adresi aşağıdaki gibidir.

\\durmaarge\ARGE_DAGITIM\SERI_MAKINELER
Genişletmek için tıkla ...

Konuya cevap yazalı iki yılı geçmiş dosyanın içindeki kodlara baktım kırmızı yerleri değiştirmeniz gerekiyor.



Kod: 
Sub dasyakopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = [COLOR="Red"]"C:\Users\MDOGRU\Desktop\TEKNİK RESİMLER KOMPLE\"[/COLOR]
hedefKlasor = [COLOR="red"]"C:\Users\MDOGRU\Desktop\satınalma\"[/COLOR]
On Error Resume Next
For i = 2 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value & ".pdf"
Cells(i, 1).Interior.ColorIndex = xlNone
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & Cells(i, 1).Value & ".pdf"
Else
Cells(i, 1).Interior.ColorIndex = 3
End If
Next i
End Sub


Kod: 
[COLOR="red"]\\durmaarge\ARGE_DAGITIM\SERI_MAKINELER\[/COLOR]

not: Bilgisayarlarınızda kısıtlamalar varsa kod çalışmayabilir.
 
Halit Bey sorunu buldum ,

İzin ile alakalı değildir ,bizim hedef klasörümüzün alt klasörleri mevcut,aşağıdaki gibi.bu yoldaki bir refarans kodunu arattım buldu.

\\durmaarge\ARGE_DAGITIM\SERI_MAKINELER\1050
\\durmaarge\ARGE_DAGITIM\SERI_MAKINELER\1125

yaklasık bunun gibi 200 alt klasör var benim refarans numaralarım bu alt klasörlerin için de ,
malum her seferinde bu klasörleri yol gösteremeyiz ana klasörden arama yapabilecek şekilde makro düzenlememiz mümkün müdür.

ana klasör.
\\durmaarge\ARGE_DAGITIM\SERI_MAKINELER
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst