Creation of File list in a new Workbook

I have an excel VBA code that:
1. uses cell information (in sheet 2) to create a directory folder structure
2. uses cell information to place the correct file to the correct foolder (that was previously created)
3. renames the files when 255 characters are exceeded
4. when there are both native files (i.e. excel, word, autocad) and pdf files of the same file these are place in sheet 3 (named attachments)
5. Creates a hyperlink in the forth tab when the files have been moved succesfully
6. the excel

I need your help for the following because i have no clue where to start from

The above is an everyday task and i need a new excel to be generated everytime new documents are received and placed to the right place, with the exact format of the Sheet2 and sheet 3 (attachments) that will have all the past and present files with the addition of a hyperlink to the last column

Code:

---

Public CopyingFilesNo As IntegerPublic Function IsFolderExists(txt As String) As Boolean


'returns true if the folder exists already, false if it does not.
IsFolderExists = CreateObject("Scripting.FileSystemObject").FolderExists(txt)
   
End Function


Sub file_move()
On Error GoTo ErrorHandler:


Dim myFile As String
Dim myPath As String 'folder to test
Dim myPaths 'to check each folder in the destination path
Dim i As Long, j As Integer, CountF As Integer
Dim ws As Worksheet 'sheet with data
Dim wsSV As Worksheet 'sheet to update
Dim lr As Long 'last row with data
Dim baseFolder As String
Dim SourceFolder As String




Dim Folder1 As String
Dim TempFolder As String




Dim Folder2 As String
Dim Folder2Plus As String


Dim tempFolderTwo As String
Dim subFolderTwo As String


Dim Folder3 As String
Dim Folder3Plus As String




Dim tempFolderThree As String
Dim subFolderThree As String


Dim Folder4 As String
Dim Folder4Plus As String


Dim tempFolderFour As String
Dim subFolderFour As String


Dim FileName As String
Dim FIleNameNew As String
Dim FileNameFinal As String


Dim CheckString As String
Dim Cnt As Integer
Dim rng As Range


baseFolder = "W:\GR-IPP_II\03. Procurement\03. EQUIPMENT\GE\"
SourceFolder = "W:\GR-IPP_II\03. Procurement\03. EQUIPMENT\GE"


Set ws = Worksheets("Sheet2") 'change sheet name as needed
Set wsSV = Worksheets("DocumentList")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Cnt = 1
CopyingFilesNo = 0
For i = 2 To lr
'Update*******************************************
    Cnt = Worksheets("DocumentList").UsedRange.Rows.Count
    Set rng = wsSV.Range("A" & Cnt + 1)
'*************************************************
   
    myPath = Replace(ws.Range("C" & i).Value, "/", "-")
    myPaths = Split(myPath, "\")
    myPath = vbNullString
    Folder1 = Trim(ws.Range("A" & i).Value)
   
    Dim fso As New FileSystemObject
  If fso.FolderExists(baseFolder + Folder1) = False Then
        fso.CreateFolder baseFolder + "" + Folder1
  End If
     
  '*********************************
   
   
    Folder2 = Replace(ws.Range("c" & i).Value, "/", "")
    Folder2Plus = Replace(ws.Range("d" & i).Value, "/", "")
   
    tempFolderTwo = Trim(Folder2) + " " + Trim(Folder2Plus)
 
 
  If fso.FolderExists(baseFolder + Folder1 + "\" + tempFolderTwo) = False Then
        fso.CreateFolder (baseFolder + Folder1 + "\" + tempFolderTwo)
  End If
 
  '************************************************************************
 
   
    Folder3 = Replace(ws.Range("e" & i).Value, "/", "")
    Folder3Plus = Replace(ws.Range("f" & i).Value, "/", "")
   
    tempFolderThree = Trim(Folder3) + " " + Trim(Folder3Plus)
 
 
  If fso.FolderExists(baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree) = False Then
        fso.CreateFolder (baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree)
  End If
  '************************************************************************
 


   
    Folder4 = Replace(ws.Range("g" & i).Value, "/", "")
    Folder4Plus = Replace(ws.Range("h" & i).Value, "/", "")
   
    tempFolderFour = Trim(Folder4) + " " + Trim(Folder4Plus)
 
 
  If fso.FolderExists(baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree + "\" + tempFolderFour) = False Then
        fso.CreateFolder (baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree + "\" + tempFolderFour)
  End If
  '************************************************************************
 
  FileName = Replace(ws.Range("AE" & i).Value, "/", "")
  CheckString = baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree + "\" + tempFolderFour + "\" + FileName
  If Len(CheckString) > 255 Then
      Dim diff As Integer
      diff = Len(CheckString) - 255
      If fso.FileExists(SourceFolder + "\" + FileName) = True Then
          FIleNameNew = Mid(FileName, 1, Len(FileName) - 5 - diff) + Mid(FileName, Len(FileName) - 4, 5)
          fso.MoveFile SourceFolder + "\" + FileName, SourceFolder + "\" + FIleNameNew
          FileNameFinal = baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree + "\" + tempFolderFour + "\" + FIleNameNew
          Call CopyFiles(SourceFolder, FIleNameNew, FileNameFinal)
          wsSV.Range("A" & Cnt + 1) = FileNameFinal
          wsSV.Range("B" & Cnt + 1) = FileName
          wsSV.Range("C" & Cnt + 1) = ws.Range("v" & i).Value
          wsSV.Range("D" & Cnt + 1) = ws.Range("t" & i).Value
          wsSV.Hyperlinks.Add wsSV.Range("A" & Cnt + 1), FileNameFinal
      End If
  Else
    FileNameFinal = CheckString
    'Call fso.CopyFile(SourceFolder + "\" + FileName, FileNameFinal, True)
    If CopyFiles(SourceFolder, FileName, FileNameFinal) = True Then
    ws.Range("AZ" & i).Value = True
      Call WriteToDocumentList(baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree + "\" + tempFolderFour + "\", FileName, ws.Range("v" & i).Value, ws.Range("t" & i).Value)
 
    End If
   
   
 
   
  End If
 
 


 
  '**********************************
  If (ws.Range("af" & i).Value) <> 0 Then
  CountF = 1
  For CountF = 1 To ws.Range("af" & i).Value
    Call AddAttachments(ws.Range("t" & i).Value, CountF, baseFolder + Folder1 + "\" + tempFolderTwo + "\" + tempFolderThree + "\" + tempFolderFour + "\", SourceFolder)
    Next CountF
  End If
 
Next i


MsgBox "FILES COPIED:" & CopyingFilesNo & " Files", vbInformation
 Exit Sub
ErrorHandler:
  MsgBox Err.Number & vbCrLf & FileName & vbCrLf & DestinationPath & vbCrLf & Err.Description, vbCritical, "ErrorInput"
End Sub


Private Function AddAttachments(FileIndex As String, Current As Integer, FileDestination As String, SourceFolder As String) As Boolean
On Error GoTo ErrorHandler:
Dim wsAtcm As Worksheet
Dim lRow As Long
 Dim rangeAtcm As Range
 Dim FoundCell As Range
 Dim FileNametcm As String
 Dim wsSV As Range


' Set wsSV = Worksheets("DocumentList")


Set wsAtcm = Worksheets("Attachments")


 Set rangeAtcm = wsAtcm.Range("A1")


Set FoundCell = wsAtcm.Range("B:B").Find(what:=FileIndex, lookat:=xlWhole)
FileNametcm = rangeAtcm.Range("I" & FoundCell.Row).Value
rangeAtcm.Range("B" & FoundCell.Row).Value = rangeAtcm.Range("B" & FoundCell.Row).Value & " Copied"
 
 Call CopyFiles(SourceFolder, FileNametcm, FileDestination & FileNametcm)
 Call WriteToDocumentList(FileDestination, FileNametcm, rangeAtcm.Range("D" & FoundCell.Row).Value, FileIndex)
 AddAttachments = True
 Exit Function
ErrorHandler:
  MsgBox Err.Number & vbCrLf & FileNametcm & vbCrLf & DestinationPath & vbCrLf & Err.Description, vbCritical, "ErrorAttachm"


End Function


Private Function CopyFiles(SourcePath As String, FileName As String, DestinationPath As String) As Boolean
Dim fso As New FileSystemObject
Dim NewStringSource As String
Dim NewDestinationPath As String
On Error GoTo ErrorHandler:
NewStringSource = SourcePath + "\" + FileName
NewDestinationPath = DestinationPath
If InStr(SourcePath + "\" + FileName, "®") Then


 NewStringSource = Replace(SourcePath + "\" + FileName, "®", "")
 fso.MoveFile SourcePath + "\" + FileName, NewStringSource
 
 NewDestinationPath = Replace(DestinationPath, "®", "")
End If


 Call fso.CopyFile(NewStringSource, NewDestinationPath, True)
 fso.DeleteFile (NewStringSource)
 CopyingFilesNo = CopyingFilesNo + 1
 CopyFiles = True
 
 Exit Function
ErrorHandler:
  MsgBox Err.Number & vbCrLf & FileName & vbCrLf & vbCrLf & DestinationPath & vbCrLf & Err.Description, vbCritical, "ErrorcOPYING"
End Function


Private Sub WriteToDocumentList(DestinationPath As String, FileName As String, RevisionDate As String, DocumentNumber As String)
Dim Cnt As Integer
Dim wsSV As Worksheet
Dim rng As Range
On Error GoTo ErrorHandler:
Set wsSV = Worksheets("DocumentList")


Cnt = 0
  Cnt = Worksheets("DocumentList").UsedRange.Rows.Count
    Set rng = wsSV.Range("A" & Cnt + 1)
        wsSV.Range("A" & Cnt + 1) = DestinationPath & FileName
    wsSV.Range("B" & Cnt + 1) = FileName
    wsSV.Range("C" & Cnt + 1) = RevisionDate
    wsSV.Range("D" & Cnt + 1) = DocumentNumber
    wsSV.Hyperlinks.Add wsSV.Range("A" & Cnt + 1), DestinationPath
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "ErrorWrite"
End Sub

---

Hello santh,

Perhaps this issue is on my end. I have downloaded your workbook twice and each time the workbook opens, there are no worksheets.

Hello Leith! and thank you for your response
i attached it as a zip. If you want to try again

Hello santh,

Thank you for the zip file. I was able to open the workbook with no problems.

Thank you for trying! Please let me know if i didn't explain well the problem. Reading my thread again makes me wonder