nabelabohasan قام بنشر يوليو 16 مشاركة قام بنشر يوليو 16 تم استخدام هذا الكود لانشاء مجلدات ولم يقم بنقل الملفات Sub MovePDFFiles() Dim srcFolder As String Dim destFolder As String Dim fileName As String Dim employeeName As String Dim srcFilePath As String Dim destFilePath As String Dim lastRow As Long Dim i As Long ' Define your source folder path where PDF files are located srcFolder = "C:\SourceFolder\" ' Get the last row with data in column E lastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "E").End(xlUp).Row ' Loop through each row in the Excel sheet For i = 2 To lastRow ' Assuming row 1 is header ' Get the employee name from column E employeeName = ThisWorkbook.Sheets("Sheet1").Cells(i, "E").Value ' Construct the full source file path fileName = "ExamplePDF.pdf" ' Replace with your actual file name or use a variable for dynamic file names srcFilePath = srcFolder & fileName ' Construct the destination folder path based on employee name destFolder = "C:\DestinationFolder\" & employeeName & "\" ' Create the destination folder if it doesn't exist If Dir(destFolder, vbDirectory) = "" Then MkDir destFolder End If ' Construct the full destination file path destFilePath = destFolder & fileName ' Check if the source file exists before moving If Dir(srcFilePath) <> "" Then ' Move the file FileCopy srcFilePath, destFilePath ' Optionally, you can delete the source file after copying ' Kill srcFilePath Else ' Handle if the source file doesn't exist MsgBox "File " & fileName & " not found in source folder!" End If Next i MsgBox "PDF files moved successfully!" End Sub رابط هذا التعليق شارك More sharing options...
كمال على طارق قام بنشر يوليو 17 مشاركة قام بنشر يوليو 17 السلام عليكم وبها نبدأ أى موضوع .. حتى تتمكن الأساتذة من مساعدتك لابد من رفع ملف مدعوم بشرح كافى عن المطلوب .. بارك الله فيك 1 رابط هذا التعليق شارك More sharing options...
فلاح الجبوري قام بنشر يوليو 27 مشاركة قام بنشر يوليو 27 On 7/17/2024 at 9:06 AM, كمال على طارق said: السلام عليكم وبها نبدأ أى موضوع .. حتى تتمكن الأساتذة من مساعدتك لابد من رفع ملف مدعوم بشرح كافى عن المطلوب .. بارك الله فيك السلام عليكم ارجو منكم المساعدة عندما اكتب الاسم الاول في القائمة المنسدلة واختار يظهر الاسم كامل في خانة الاسم like.xlsm رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر يوليو 28 مشاركة قام بنشر يوليو 28 Hello Nabil Try this code Sub Move_PDF_Files() Dim ws As Worksheet, sDesktop As String, srcFolder As String, desFolder As String, empName As String, sFile As String, TargetFolder As String, lr As Long, r As Long Set ws = ThisWorkbook.Sheets("Sheet1") sDesktop = Environ("UserProfile") & "\Desktop\" srcFolder = sDesktop & "SourceFolder\" desFolder = sDesktop & "DestinationFolder\" If Dir(desFolder, vbDirectory) = "" Then MkDir desFolder lr = ws.Cells(Rows.Count, "E").End(xlUp).Row For r = 2 To lr empName = ws.Cells(r, "E").Value sFile = empName & ".pdf" TargetFolder = desFolder & empName & "\" If Dir(TargetFolder, vbDirectory) = "" Then MkDir TargetFolder If Dir(srcFolder & sFile) <> "" Then FileCopy srcFolder & sFile, TargetFolder & sFile Else Debug.Print "File [" & sFile & "] Not Found In Source Folder" End If Next r MsgBox "PDF Files Moved Successfully!", 64 End Sub This is for illustration 2 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.