Soru Userform ile Bir Klasörden Başka Bir Klasöre Dosya(ları) Taşıma

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Herkese Merhaba
Dosya taşıma konusunda bir şeyler yaptım ama sanırım taşıma butonuna gereken kodu tam yazamadım

Yaptığım:

Dosya_Transferi adlı userformumda
TextBox1 e çift tıklayınca Kaynak Klasörden dosya seçilebiliniyor. TextBox1 in yanındaki ... butona tıklanınca Kaynak Klasör seçiliyor
TextBox2 e çift tıklayınca Hedef Klasörden dosya seçilebiliniyor. TextBox2 nin yanındaki ... butona tıklanınca Hedef Klasör seçiliyor

Yapamadığım :

Taşı butonuna tıklayınca Textbox1 deki dosya Textbox2 deki yola taşınsın (eğer TextBox2 deki yolda aynı adla dosya varsa uyarı versin dosya değiştirilsin mi diye

Taşı butonuna tıklayınca Textbox1 de klasör seçili ise bu klasördeki tüm dosyalar Textbox2 deki yola taşınsın (eğer TextBox2 deki yolda aynı adla dosya varsa her dosya için uyarı versin dosya değiştirilsin mi diye

Yardım edebilecek olan varsa çok sevinirim.
 

Ekli dosyalar

S

sqrm

Katılım
13 Haziran 2006
Mesajlar
49
Excel Vers. ve Dili
excell 2016 türkçe
Altın Üyelik Bitiş Tarihi
09/06/2022
Merhaba,

Şu an üzerinde çalıştığım bir dosyada benzer bir iş yaptığımdan size de yardımcı olması için klasör bazlı dosya taşımaya bir örnek hazırladım. Dosya taşıma buttonunun altına kodları sıralarsanız çalışacaktır.

iyi günler dilerim

Kod: 
Dim xTFile As String
    Dim strFileName As String
    Dim strFileExists As String
    Dim xExtArr As Variant
    Dim xExt As Variant
    Dim xSPath As String
    Dim xDPath As String
    Dim xSFile As String
    Dim xCount As Long
    Dim NewxSFile As String
    xSPath = TextBox1.Value
    xDPath = TextBox2.Value
    
    If Right(xDPath, 1) <> "\" Then xDPath = xDPath + "\"
    If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
    xExtArr = Array("*.*", "*.jpg")
    For Each xExt In xExtArr
        
        xTFile = Dir(xSPath & xExt)
                
        
        
        Do While xTFile <> ""
            xSFile = xSPath & xTFile
            strFileExists = Dir(xDPath & xTFile)
            FileExists = 0
            If strFileExists <> "" Then
                FileExists = 1
            End If
            
            xTFile = Dir(xSPath & xExt)
            
            If FileExists = 0 Then
                FileCopy xSFile, xDPath & xTFile
            Else
                If MsgBox(xTFile & " isimli dosya zaten mevcut!" & vbNewLine & vbNewLine & "Yeniden adlandırılarak kayıt yapılsın mı?", vbQuestion + vbYesNo, "Dikkayyt") = vbYes Then
                    For noktabul = 1 To Len(xTFile)
                        If Mid(xTFile, noktabul, 1) = "." Then
                            noktasayisi = noktabul - 1
                        End If
                    Next
                
                    NewxSFile = Left(xTFile, noktasayisi) & " (" & Format(Now, "dd.mm.yyyy.hh.mm") & " tarihli kopya" & ")" & Mid(xTFile, noktasayisi + 1, Len(xTFile))
                
                    FileCopy xSFile, xDPath & NewxSFile
                Else
                    FileCopy xSFile, xDPath & xTFile
                End If
            End If
            Kill xSFile
            xTFile = Dir
            xCount = xCount + 1

        Loop

    Next
    MsgBox "Toplam taşınan dosya sayısı " & xCount, vbInformation, "ReaVista Klasörden Klasöre Dosya Taşıma Hizmetleri"
 

Ekli dosyalar

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Sayın @sqrm paylaşım için çok teşekkür ederim. Yaptığınız kısım tam istediğim.

Ama şu kısım eksik
Textbox1 e çift tıklayınca dosya ya kadar seçiyorum
Misal c:\\deneme.pdf
Sonra textbox2 nün yanındaki ... butona tıklayınca dosyanın taşınacağı konum seçiliyor.
Dosyayı taşı diyince textbox1 de seçili olan dosyanın textbox2 deki konuma taşınması eksik kaldı aynı adda dosya varsa taşınsın mı diye sorması gerekiyor.

Sayın @sqrm bu konuda da yardımcı olursanız çok sevinirim .
 

Ekli dosyalar

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
TURKOLOG' Alıntı:
Sayın @sqrm paylaşım için çok teşekkür ederim. Yaptığınız kısım tam istediğim.

Ama şu kısım eksik
Textbox1 e çift tıklayınca dosya ya kadar seçiyorum
Misal c:\\deneme.pdf
Sonra textbox2 nün yanındaki ... butona tıklayınca dosyanın taşınacağı konum seçiliyor.
Dosyayı taşı diyince textbox1 de seçili olan dosyanın textbox2 deki konuma taşınması eksik kaldı aynı adda dosya varsa taşınsın mı diye sorması gerekiyor.

Sayın @sqrm bu konuda da yardımcı olursanız çok sevinirim .
Genişletmek için tıkla ...
Şöyle bir şey yaptım ama sonda hata veriyor. Yardım edebilecek Var mı Acaba
Kod altta bir yerde hata veriyor onu yapamadım
Kod: 
Private Sub CommandButton3_Click()

Dim Yeni_Klasör_Yolu As String, Dosya_Yol As String, Dosya_isim As String
  
    Yeni_Klasor_Yolu = TextBox2.Text ' hedef yolu kendinize göre belirleyin
  
    Dosya_Yol = TextBox1.Text
    Dosya_isim = TextBox1.Name
  
    TextBox1.Copy Yeni_Klasor_Yolu & "\" & Dosya_isim
    Kill Dosya_Yol & "\" & Dosya_isim


End Sub
 

Ekli dosyalar

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Kod: 
Private Sub CommandButton3_Click()
Dim EskiKlasoru As String, HedefKlasoru As String


EskiKlasoru = TextBox1.Value
HedefKlasoru = TextBox2.Value

            FileCopy EskiKlasoru, HedefKlasoru
            Kill xSFile
          
                
End Sub
Resimdeki gibi TextBox1 de uzantısına kadar dosya yolu var TextBox2 de koplayalanacağı dosya adresi var butona basınca dosyayı taşıyacak yardım edebilecek olan va rmıAdsız.png
 
A

assenucler

Altın Üye
Katılım
19 Ağustos 2004
Mesajlar
3,521
Excel Vers. ve Dili
Ofis 365 TR 64 Windows 11 Home Single Language x64 TR
Altın Üyelik Bitiş Tarihi
29-05-2025
Değerli Dostlar;

Üyelerimizin 1 ve 2 nolu iletiye eklediği dosyalarda "Form" gözükmüyor. Ne yapmalıyım?
Yardımınız için teşekkürler.

216440
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,760
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bir dosya ekledim iki adet form var birisi seçilen klasörü taşıyor diğeri dosyayı taşıyor.
Not: Kontrol kodları koymadım sadece taşıma işlemini yapıyor kodlar.
 

Ekli dosyalar

A

assenucler

Altın Üye
Katılım
19 Ağustos 2004
Mesajlar
3,521
Excel Vers. ve Dili
Ofis 365 TR 64 Windows 11 Home Single Language x64 TR
Altın Üyelik Bitiş Tarihi
29-05-2025
Sayın @TURKOLOG,

İlk iletiye eklediğiniz dosyanın kod sayfasında "Form" görüntüsü olmasına karşın, ilk sayfada Form'un gözükmemesi üzerine; bir an için Office 365'ten mi kaynaklanan bir sorun olabileceğini düşünerek, mesajı yazdım.


Sayın @halit3,

İlginiz ve yanıtınız için teşekkür ederim.

Saygılar,
 
S

sqrm

Katılım
13 Haziran 2006
Mesajlar
49
Excel Vers. ve Dili
excell 2016 türkçe
Altın Üyelik Bitiş Tarihi
09/06/2022
Sayın @TURKOLOG,

Tekli dosya taşıma için de hedef klasörde aynı isimde dosya olup olmadığını kontrol eden kodlar dosyanıza eklenmiştir.

Kod: 
Dim fL As Object
Dim strFileExists As String
Set fL = CreateObject("Scripting.FileSystemObject")

If Dir(TextBox2.Text) <> "" Then
    For slashbul = 1 To Len(TextBox1.Text)
        
        If Mid(TextBox1.Text, slashbul, 1) = "\" Then
            slashsayisi = slashbul
            
        End If
    Next slashbul
    
    For slashbul2 = 1 To Len(TextBox2.Text)
        
        If Mid(TextBox2.Text, slashbul2, 1) = "\" Then
            slashsayisi2 = slashbul2
            
        End If
    Next slashbul2
    
  
    dosyaadi = Mid(TextBox1.Text, slashsayisi + 1, Len(TextBox1.Text))
    
    
    If MsgBox(dosyaadi & " isimli dosya zaten mevcut!" & vbNewLine & vbNewLine & "Yeniden adlandırılarak kayıt yapılsın mı?", vbQuestion + vbYesNo, "Dikkayyt") = vbYes Then
                    For noktabul = 1 To Len(TextBox2.Text)
                        If Mid(TextBox2.Text, noktabul, 1) = "." Then
                            noktasayisi = noktabul - 1
                        End If
                    Next
                
                    NewxSFile = Left(TextBox2.Text, noktasayisi) & " (" & Format(Now, "dd.mm.yyyy.hh.mm") & " tarihli kopya" & ")" & Mid(TextBox2.Text, noktasayisi + 1, Len(TextBox2.Text))
                
                    
                    
                    fL.MoveFile TextBox1.Text, NewxSFile
                    MsgBox "Dosya başarıyla taşınmıştır.", vbInformation, "ReaVista Klasörden Klasöre Dosya Taşıma Hizmetleri"
                    
    Else
                    fL.MoveFile TextBox1.Text, TextBox2.Text
                    MsgBox "Dosya başarıyla taşınmıştır.", vbInformation, "ReaVista Klasörden Klasöre Dosya Taşıma Hizmetleri"
    End If
End If
 

Ekli dosyalar

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
sqrm' Alıntı:
Sayın @TURKOLOG,

Tekli dosya taşıma için de hedef klasörde aynı isimde dosya olup olmadığını kontrol eden kodlar dosyanıza eklenmiştir.

Kod: 
Dim fL As Object
Dim strFileExists As String
Set fL = CreateObject("Scripting.FileSystemObject")

If Dir(TextBox2.Text) <> "" Then
    For slashbul = 1 To Len(TextBox1.Text)
       
        If Mid(TextBox1.Text, slashbul, 1) = "\" Then
            slashsayisi = slashbul
           
        End If
    Next slashbul
   
    For slashbul2 = 1 To Len(TextBox2.Text)
       
        If Mid(TextBox2.Text, slashbul2, 1) = "\" Then
            slashsayisi2 = slashbul2
           
        End If
    Next slashbul2
   
 
    dosyaadi = Mid(TextBox1.Text, slashsayisi + 1, Len(TextBox1.Text))
   
   
    If MsgBox(dosyaadi & " isimli dosya zaten mevcut!" & vbNewLine & vbNewLine & "Yeniden adlandırılarak kayıt yapılsın mı?", vbQuestion + vbYesNo, "Dikkayyt") = vbYes Then
                    For noktabul = 1 To Len(TextBox2.Text)
                        If Mid(TextBox2.Text, noktabul, 1) = "." Then
                            noktasayisi = noktabul - 1
                        End If
                    Next
               
                    NewxSFile = Left(TextBox2.Text, noktasayisi) & " (" & Format(Now, "dd.mm.yyyy.hh.mm") & " tarihli kopya" & ")" & Mid(TextBox2.Text, noktasayisi + 1, Len(TextBox2.Text))
               
                   
                   
                    fL.MoveFile TextBox1.Text, NewxSFile
                    MsgBox "Dosya başarıyla taşınmıştır.", vbInformation, "ReaVista Klasörden Klasöre Dosya Taşıma Hizmetleri"
                   
    Else
                    fL.MoveFile TextBox1.Text, TextBox2.Text
                    MsgBox "Dosya başarıyla taşınmıştır.", vbInformation, "ReaVista Klasörden Klasöre Dosya Taşıma Hizmetleri"
    End If
End If
Genişletmek için tıkla ...
Sayın @sqrm elinize emeğinize sağlık. Çok teşekkür ederim.
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Sayın @sqrm
Eğer hedef klasörde dosya varsa ismini değiştirip Hedef Klasöre kopyalıyor Ama Hedef Kalsöründe Kaynak Klasöründe seçili dosya yoksa (yani benzersiz dosya ise) taşıma işlemini yapmıyor . Bu kısımda bir sorun oluşmuş. Bakma imkanınız var mı acaba
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
sqrm' Alıntı:
Sayın TURKOLOG düzelttim dosyayı bu hali çalışıyor.
Genişletmek için tıkla ...
Sayın @sqrm
Elinize emeğinize sağlık . Dosya çalışıyor. Çok teşekkür ederim. Bu konuda arama yapacaklar için dosyaların son halini paylaşıyorum.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Üst