طلب مساعده في كود لنقل مجموعة ملفات موجوده في مجلد الى مجلد آخر

[imad2024]

السلام عليكم طلب مساعده في كود  لنقل مجموعة ملفات موجوده في مجلد الى مجلد اخر

خلال البحث وجدت كود لنقل ملف واحد من مكان الى اخر

"FileCopy "C:\1\1.docx", "c:\2\1.docx

انا بحاجه الى نقل جميع الملفات مره واحده الى مجلد اخر

ولكم الشكر

[Moosak]

وعليكم السلام 🙂 

بدل نقلها ملف ملف .. أنقل المجلد كاملا بما فيه هكذا :

FileCopy "C:\1", "C:\2"

 

[imad2024]

شكرا لك

اسف على التاخر على الرد بسبب الانقطاع

تم تجربته يعطي خطأ

FileCopy "C:\1", "C:\2"

المجلدين موجودات وعند تعديل المعادله لنقل ملف واحد يقوم بالنقل 

مع الشكر

 

[Foksh]

جرب هذا المرفق أخي @imad2024 

Copy Files.accdb

 

تم انشاء مربعي النص ( Text1 , Text2 ) لتحديد المسارات ( المصدر والهدف )

وتم انشاء الزرين ( Btn1 , Btn2 ) بجانب كل مربع نص لتحديد مسار المجلدات .

وتم انشاء زر لتنفيذ عملية النسخ من - إلى

وتم انشاء دالة مستقلة للنسخ CopyFolder .

 

Private Sub Btn_Copy_Click()
    If Text1.Value <> "" And Text2.Value <> "" Then
        Dim sourcePath As String
        Dim destPath As String
        sourcePath = Text1.Value
        destPath = Text2.Value
        If Dir(sourcePath, vbDirectory) <> "" Then
            If Dir(destPath, vbDirectory) <> "" Then
                CopyFolder sourcePath, destPath
                MsgBox "تم نقل الملفات بنجاح", vbInformation
            Else
                MsgBox "المجلد الهدف غير موجود", vbExclamation
            End If
        Else
            MsgBox "المجلد المصدر غير موجود", vbExclamation
        End If
    Else
        MsgBox "يرجى تحديد مسار لكل من المجلد المصدر والمجلد الهدف", vbExclamation
    End If
End Sub

Private Sub Btn1_Click()
    Dim dialog As FileDialog
    Dim selectedFolder As Variant
    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    If dialog.Show = -1 Then
        selectedFolder = dialog.SelectedItems(1)
        Text1.Value = selectedFolder
    End If
End Sub

Private Sub Btn2_Click()
    Dim dialog As FileDialog
    Dim selectedFolder As Variant
    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    If dialog.Show = -1 Then
        selectedFolder = dialog.SelectedItems(1)
        Text2.Value = selectedFolder
    End If
End Sub

Private Sub CopyFolder(ByVal sourcePath As String, ByVal destPath As String)
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    Dim sourceFolder As Folder
    Set sourceFolder = fso.GetFolder(sourcePath)
    
    Dim destFolder As Folder
    Set destFolder = fso.GetFolder(destPath)
    
    fso.CopyFolder sourceFolder.Path, destFolder.Path
End Sub

 

تم تعديل أبريل 20, 2024 بواسطه Foksh

[imad2024]

شكرا لك 

لقد تم تجربة البرنامج المرفق وتم نقل جميع الملفات بنجاح

وقمت بالتعديل عليه بوضع كود لحذف الملفات من المجلد الاول بعد نقل الملفات الى المجلد الثاني

حيث تمت عملية النقل والحذف بشكل ممتاز

شكرا لك مره اخرى على الرد السريع

 

تم تعديل أبريل 20, 2024 بواسطه imad2024

[Foksh]

تفضل ، استبدل هذا الكود للنموذج :-

Private Sub Btn_Copy_Click()
    If Text1.Value <> "" And Text2.Value <> "" Then
        Dim sourcePath As String
        Dim destPath As String
        sourcePath = Text1.Value
        destPath = Text2.Value
        If Dir(sourcePath, vbDirectory) <> "" Then
            If Dir(destPath, vbDirectory) <> "" Then
                CopyFiles sourcePath, destPath
                DeleteFilesInFolder sourcePath
                MsgBox "تم نقل الملفات بنجاح", vbInformation
            Else
                MsgBox "المجلد الهدف غير موجود", vbExclamation
            End If
        Else
            MsgBox "المجلد المصدر غير موجود", vbExclamation
        End If
    Else
        MsgBox "يرجى تحديد مسار لكل من المجلد المصدر والمجلد الهدف", vbExclamation
    End If
End Sub

Private Sub CopyFiles(ByVal sourcePath As String, ByVal destPath As String)
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    Dim sourceFolder As folder
    Set sourceFolder = fso.GetFolder(sourcePath)
    
    Dim destFolder As folder
    Set destFolder = fso.GetFolder(destPath)
    
    Dim file As file
    For Each file In sourceFolder.Files
        fso.CopyFile file.Path, destFolder.Path & "\" & file.Name
    Next file
End Sub

Private Sub DeleteFilesInFolder(ByVal folderPath As String)
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    Dim folder As folder
    Set folder = fso.GetFolder(folderPath)
    
    Dim file As file
    For Each file In folder.Files
        fso.DeleteFile file.Path
    Next file
End Sub

Private Function IsFolderEmpty(ByVal folderPath As String) As Boolean
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    Dim folderContents As Files
    Set folderContents = fso.GetFolder(folderPath).Files
    
    IsFolderEmpty = (folderContents.Count = 0)
End Function

Private Sub Btn1_Click()
    Dim dialog As FileDialog
    Dim selectedFolder As Variant
    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    If dialog.Show = -1 Then
        selectedFolder = dialog.SelectedItems(1)
        Text1.Value = selectedFolder
    End If
End Sub

Private Sub Btn2_Click()
    Dim dialog As FileDialog
    Dim selectedFolder As Variant
    Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
    If dialog.Show = -1 Then
        selectedFolder = dialog.SelectedItems(1)
        Text2.Value = selectedFolder
    End If
End Sub

 

Copy Files.accdb