Sub temp()
    Application.DisplayAlerts = False
    For i = 6 To Cells(Rows.Count, 2).End(xlUp).Row
    Range("F" & i).FormulaR1C1 = "=MID(RC[-3],1,LEN(RC[-3])-4)"
    Path = Cells(i, 6).Value
    MkDir Path
    Path = Path & "\photo"
    MkDir Path
        FileCopy Cells(i, 3).Value, Path & "\" & Cells(i, 2).Value
    Next
    Application.DisplayAlerts = True
End Sub