تم استخدام هذا الكود لانشاء مجلدات ولم يقم بنقل الملفات
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
