كود vba لانشاء محلدات ونقل ملفات pdf من سطح المكتب الى مجلد بأسم الموظف

[nabelabohasan]

تم استخدام هذا الكود لانشاء مجلدات ولم يقم بنقل الملفات 

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

[كمال على طارق]

السلام عليكم وبها نبدأ أى موضوع .. حتى تتمكن الأساتذة من مساعدتك لابد من رفع ملف مدعوم بشرح كافى عن المطلوب .. بارك الله فيك

[فلاح الجبوري]

On 7/17/2024 at 9:06 AM, كمال على طارق said:

السلام عليكم وبها نبدأ أى موضوع .. حتى تتمكن الأساتذة من مساعدتك لابد من رفع ملف مدعوم بشرح كافى عن المطلوب .. بارك الله فيك

السلام عليكم ارجو منكم المساعدة

عندما اكتب الاسم الاول في القائمة المنسدلة واختار يظهر الاسم كامل في خانة الاسم 

like.xlsm

[lionheart]

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