Seçilen dosyayı, seçilen klasörün altına koplamak

[BG]

Merhaba,

aşağıdaki kodda amacım seçilen klasördeki bir dosyayı (jpg) yine diogboxta seçtiğim klasörün altına kopyalamak bir hata yapıyorum fakat bulamadım
yardımcı olursanız sevirim , teşekkürler.

Private Sub CommandButton1_Click()
'----- dosya kopyalama------------
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Dosya Seçiniz"
If .Show = True Then
dosya = .SelectedItems(1)
End If
End With

Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
Label19.Caption = ObjFolder.Items.Item.Path
FileCopy dosya, Label19.Caption
'--------------------------------------

End Sub

 

[Muzaffer Ali]

Merhaba.
Hedef klasör belirtmişsiniz fakat hedef dosya adını belirtmemişsiniz onun için hata veriyor.

Private Sub CommandButton1_Click()
    Dim fso As Object
    Dim dosya As String
    Dim hedefYol As String
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")

    ' Dosya seçimi
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Dosya Seçiniz"
        If .Show = True Then
            dosya = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ' Klasör seçimi
    Dim ObjFolder As Object
    Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
    If Not ObjFolder Is Nothing Then
        Label19.Caption = ObjFolder.Items.Item.Path
        hedefYol = Label19.Caption & "\" & fso.GetFileName(dosya)
        FileCopy dosya, hedefYol
        MsgBox "Dosya başarıyla kopyalandı!", vbInformation
    Else
        MsgBox "Klasör seçilmedi.", vbExclamation
    End If
End Sub

 

[BG]

anladım, tamam üstad emeğin için çok teşekkür ederim, sağolasın.

 

[BG]

birden fazla dosya yüklemek için nasıl bir değişiklik yapmak lazım acaba?

 

[Korhan Ayhan]

Böyle olabilir...

Private Sub CommandButton1_Click()
    Dim fso As Object
    Dim hedefKlasor As String
    Dim ObjFolder As Object
    Dim i As Long

    Set fso = CreateObject("Scripting.FileSystemObject")

    ' --- Çoklu Dosya Seçimi ---
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Kopyalanacak Dosyaları Seçiniz"
        .AllowMultiSelect = True ' <<< Çoklu seçim aktif
        If .Show <> -1 Then Exit Sub ' Vazgeçildiyse çık
        If .SelectedItems.Count = 0 Then Exit Sub
    End With

    ' --- Klasör seç ---
    Set ObjFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Hedef klasörü seçin:", &H100)
    If ObjFolder Is Nothing Then
        MsgBox "Klasör seçilmedi!", vbExclamation
        Exit Sub
    End If

    hedefKlasor = ObjFolder.Items.Item.Path
    Label19.Caption = hedefKlasor

    ' --- Her seçilen dosyayı hedef klasöre kopyala ---
    For i = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
        Dim kaynakDosya As String, hedefDosya As String
        kaynakDosya = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(i)
        hedefDosya = hedefKlasor & "\" & fso.GetFileName(kaynakDosya)
        FileCopy kaynakDosya, hedefDosya
    Next i

    MsgBox "Seçilen dosyalar başarıyla kopyalandı!", vbInformation
End Sub

 

[BG]

Üstad her zamanki gibi yine harikasın, eyvallah teşekkür ederim.