excel dosyayı otomatik kopyalama

[İhsan Tank]

selamun aleyküm arkadaşlar

sorum şu :
genel.xls dosyasında bulunan userform'daki combobox'ta Klasörün içindeki excel dosyalarının isimlerini yazdırıyorum.
istediğim ise şu : eğer ki girdiğim isimde excel dosyası bulunmuyor ise A klasöründeki AAAYEDEK.xls dosyasından bir tane A klasörüne.
b klasöründeki AAAYEDEK.xls dosyasından bir tane B Klasörüne otomatik kopyalanıp ismini combobox'a yazdığım bilginin olması.

örneğin klasörlerde
AAAYEDEK ve AB adlı 2 excel dosyası mevcut. ben eğer ki combobox'a BA yazarsam A klasöründe AAAYEDEK.xls'den bir kopya alıp adını ba olarak değiştirip yeni bir dosya oluşturmasını ve B klasöründeki AAAYEDEK.xls'den bir kopya alıp adını ba olarak değiştirip yeni bir dosya okuşturmasını istiyorum.

yani işlem bittiğinde
A ve B klasörlerinde AAAYEDEK - AB - BA adlı 3 dosya olacak.

örnek dosya ekte basit olması açısından çoğaltılacak dosyalar boş gönderilmiştir.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Yazdığınız dosya adı iki klasörde de yoksa dosya oluşturma işlemi yapılmaktadır. Eğer klasörler ayrı ayrı sorgulanacaksa kırmızı renkli IF sorgusunu parçalamak gerekecektir.

Option Explicit
 
Private Sub CommandButton1_Click()
    Dim DOSYA1 As String, DOSYA2 As String
    Dim HEDEF_KLASÖR1 As String, HEDEF_KLASÖR2 As String
    Dim DOSYA_SİSTEMİ As Object
 
    Set DOSYA_SİSTEMİ = CreateObject("Scripting.FileSystemObject")
 
    If ComboBox1 = "" Then Exit Sub
 
    HEDEF_KLASÖR1 = ThisWorkbook.Path & "\1\" & ComboBox1 & ".xls"
    HEDEF_KLASÖR2 = ThisWorkbook.Path & "\2\" & ComboBox1 & ".xls"
    DOSYA1 = ThisWorkbook.Path & "\1\" & "aaayedek.xls"
    DOSYA2 = ThisWorkbook.Path & "\2\" & "aaayedek.xls"
 
[COLOR=red]   If Dir(HEDEF_KLASÖR1) = "" And Dir(HEDEF_KLASÖR2) = "" Then[/COLOR]
[COLOR=red]       DOSYA_SİSTEMİ.CopyFile DOSYA1, HEDEF_KLASÖR1[/COLOR]
[COLOR=red]       DOSYA_SİSTEMİ.CopyFile DOSYA2, HEDEF_KLASÖR2[/COLOR]
[COLOR=red]       MsgBox "İşleminiz tamamlanmıştır.", vbInformation[/COLOR]
[COLOR=red]   End If[/COLOR]
 
    Set DOSYA_SİSTEMİ = Nothing
End Sub

 

[İhsan Tank]

hocam çok teşekkür ederim.
istediğim işlemi yapıyor.
tek bir sorun var yukarıda söylediğiniz kısmı tam anlamadım.
benim iki dosyamda aynı tarz dosyalar mevcut. aynı birebir dosyalar.

 

[omerceri]

Bende biraz uğraştım.
Forma bir düğme ekleyin, kod kısmına aşağıdaki kodları yapıştırın
Private Sub CommandButton1_Click()
If ComboBox1 = "" Then Exit Sub
say = ComboBox1.ListCount
test = 0
For i = 0 To say - 1
If ComboBox1.Text = ComboBox1.List(i) Then
test = 1
Exit Sub
End If
Next


If Text = 0 Then
Set fs = CreateObject("Scripting.FileSystemObject")

fs.CopyFile "D:\veri\a\AAAYEDEK.xls", "D:\veri\a\" & ComboBox1.Text & ".xls"
fs.CopyFile "D:\veri\b\AAAYEDEK.xls", "D:\veri\b\" & ComboBox1.Text & ".xls"
End If
End Sub

 

[İhsan Tank]

korhan hocam
var olan dosyada bu kodun herhangi bir işlem yapmamasını nasıl sağlarım

 

[İhsan Tank]

arkadaşlar sorun halledilmiştir.

If Dir(HEDEF_KLASÖR1) = "" And Dir(HEDEF_KLASÖR2) = "" Then
[COLOR="Red"]' msgbox'la uyarı ekledim haloldu"[/COLOR]       
DOSYA_SİSTEMİ.CopyFile DOSYA1, HEDEF_KLASÖR1
       DOSYA_SİSTEMİ.CopyFile DOSYA2, HEDEF_KLASÖR2
       MsgBox "İşleminiz tamamlanmıştır.", vbInformation
   End If

korhan hocama çok teşekkür ederim
ayrıca alternati folarak zamanını harcayan Syn : ömerceri'ye de teşekkür ederim