Программное изменение файла при копировании текущей БД

'Процедура создания клиента №1
Sub CreateClientsForObjectsSTnew()
  
  
  Dim PathSourceFolder As String
  Dim PathCopyFolder As String
  Dim NameSourceFile As String
  Dim NameClientFile As String
  
  Dim objAcc As Access.Application
  
  
  PathSourceFolder = "C:\Users\VG\DataBaseVG\New"
  PathCopyFolder = "C:\Users\VG\DataBaseVG\New\Test"
  
  NameSourceFile = "dbObjectsSTnew.accdb"
  NameClientFile = "Клиент.accdb"
  
  NameClientFileWithPath = PathCopyFolder & "" & NameClientFile
  
    
  '1 Выполнить процедуру копирования файла (idProc=3 idElement=728)
  Call CopyFile(PathSourceFolder, PathCopyFolder, NameSourceFile)
  
  '2 Выполнить процедуру изменения имени файла (idProc=2 idElement=726)
  Call AlterNameOfFile(PathCopyFolder, NameSourceFile, NameClientFile)
  
  '3 Включение всех макросов и процедур
  Set objAcc = New Access.Application
  objAcc.OpenCurrentDatabase (NameClientFileWithPath)
  objAcc.AutomationSecurity = msoAutomationSecurityLow
      
End Sub
 
    'Процедура копирования файла
    Sub CopyFile(PathSourceFolder As String, PathCopyFolder As String, NameFile As String)
 
      Dim objFSO As Object
      Dim objFile As Object
       
      'полное имя файла c путем Папки-источником
      NameFileWithSourcePath = PathSourceFolder & "" & NameFile
      
      'полное имя файла c путем Папки-копирования
      NameFileWithCopyPath = PathCopyFolder & "" & NewNameFile
       
       
      'Проверка наличия копируемого файла
      If Dir(NameFileWithSourcePath, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub
      
      'копируем файл
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      Set objFile = objFSO.GetFile(NameFileWithSourcePath)
      
      objFile.Copy NameFileWithCopyPath
        
    End Sub
    
    'Процедура изменения имени файла
    Sub AlterNameOfFile(PathSourceFolder As String, NameFile As String, NewNameFile As String)
      
      'старое имя файла c путем хранения
      NameFileWithPath = PathSourceFolder & "" & NameFile
 
      'новое имя файла c путем хранения
      NewNameFileWithPath = PathSourceFolder & "" & NewNameFile
 
      'проверка условия наличия файла для переименования
      If Dir(NameFileWithPath, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub
 
      'переименовываем файл
      Name NameFileWithPath As NewNameFileWithPath
 
    End Sub

Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "Msaccess.exe C:\Users\VG\DataBaseVG\New\Test\Клиент.accdb"
Set objAcc = GetObject("C:\Users\VG\DataBaseVG\New\Test\Клиент.accdb")
objAcc.automationSecurity = 1 'msoAutomationSecurityLow

Private Sub Form_Load()
    Application.AutomationSecurity = msoAutomationSecurityLow '=1
End Sub