Ali Ammar

ردا على سؤالك لما لا يتم تمرير اسم الملف او اسم المجلد اريد في كل مرة نقل ملفات الي مجلدات مختلفة شكرا الك رح اجرب الكود واردلك النتيجة الف شكر الك

استاذي الكريم الكود سيقوم بالعملية ل 1000 ملف يطلب تحديد المجلد لمرة واحدة فقط فرضا لدي 1000 ملف ومجلد A يحتوي على 1000 مجلد مثال عن اسماء المجدلات ال1000 A1 ,A2,A3,A4,A5 .... الى A1000 بداخل كل مجلد 10 مجلدات فرعية اسمائها/ A1-1/A1-2/A1-3....الخ يقوم الكود بمطابقة اسم الملف مع اسم المجلد (من مجلدA) في حال التطابق يقوم بفتح المجلد يظهر قائمة مستعرض فيها اسماء المجلدات ال10 بمجرد اخيارك لمجلد واحد يقوم الكود بتنفيذ النسخ لكل ملف يتطابق اسمه مع اسم المجلد من الالف طبعا النسخ داخل مجلد اسماء المجلدات ال10 (/ A1-1/A1-2/A1-3....الخ) واحدة في ال 1000مجلد مثلا: اسم الملف A1 يذهب للمجلد A1 هنا طابق اسم الملف لاسم المجلد يقوم بفتح المجلد هنا تظهر قائمة فيها اسماء المجلدات ال10 هنا نختار المجلد الهدف ويقوم بنسخ الملف بداخليه ويتم تعميم العملية على جميع الملفات المتطابقة بالاسماء مع اسماء المجلدات الرئيسة A1 ,A2,A3,A4,A5 .... الى A1000

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

لدي كود برمجي اطلب منه نسخ ملفات pdf الى مجلد يحتوي على 100 مجلد وكل مجلد من ال 100 يوجد فيه 10 مجلدات الكود التالي يقوم بنسخ الملفات الي جانب ال 10 مجلدات هل يمكن المساعدة في تعديل الكود ليقوم بالمطلوب وهو اريد نسخ الملف الى مجلد اقم باختياره عبرة نافذة يقدمها البرنامج من ال 10 مجلدات فرعية التي تحتوي عليها المجلدات ال 100 Sub CopyMatchingFilesAndFolders() Dim sourcePath As String Dim targetPath As String Dim sourceFiles As Collection Dim targetFolders As Collection Dim fileName As String Dim folderName As String Dim fileItem As Variant Dim folderItem As Variant Dim extension As String ' ?????? ???? ?????? With Application.FileDialog(msoFileDialogFolderPicker) .Title = "اختيار مجلد المصدر" If .Show = -1 Then sourcePath = .SelectedItems(1) & "\" Else MsgBox "لم يتم اختيار مجلد المصدر ." Exit Sub End If End With ' ?????? ???? ????? With Application.FileDialog(msoFileDialogFolderPicker) .Title = "اختيار مجلد الهدف" If .Show = -1 Then targetPath = .SelectedItems(1) & "\" Else MsgBox "لم يتم اختيار مجلد الهدف " Exit Sub End If End With Set sourceFiles = GetFilesCollection(sourcePath) Set targetFolders = GetFoldersCollection(targetPath) For Each fileItem In sourceFiles fileName = fileItem extension = Right(fileName, 4) ' ?????? ???????? ".pdf" fileName = Left(fileName, Len(fileName) - Len(extension)) For Each folderItem In targetFolders folderName = folderItem If Right(folderName, Len(extension)) = extension Then folderName = Left(folderName, Len(folderName) - Len(extension)) End If If fileName = folderName Then FileCopy sourcePath & fileItem, targetPath & folderItem & "\" & fileItem End If Next folderItem Next fileItem MsgBox "تم نسخ الملفات بنجاح!" End Sub Function GetFilesCollection(ByVal path As String) As Collection Dim files As New Collection Dim file As String file = Dir(path & "*.*") Do While file <> "" If (GetAttr(path & file) And vbDirectory) = 0 Then files.Add file End If file = Dir Loop Set GetFilesCollection = files End Function Function GetFoldersCollection(ByVal path As String) As Collection Dim folders As New Collection Dim folder As String folder = Dir(path, vbDirectory) Do While folder <> "" If folder <> "." And folder <> ".." And (GetAttr(path & folder) And vbDirectory) <> 0 Then If InStr(1, folder, "-") > 0 Then folders.Add folder End If End If folder = Dir Loop Set GetFoldersCollection = folders End Function