Gerade erst kappiert das du n Verzeichnis umbenennen willst. hab mich vorhin verlesen. ;)

'Module: modShellAPI
Option Explicit
 
#If VBA7 Then
 
Private Declare PtrSafe Function SHFileOperationW Lib "shell32" ( _
  lpFileOp As SHFILEOPSTRUCT _
) As Long

Private Type SHFILEOPSTRUCT
  hWnd As LongPtr
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Boolean
  hNameMappings As LongPtr
  lpszProgressTitle As String
End Type

#End If

'(some!) shell api return codes
Private Const ERROR_SUCCESS As Long = 0

'(some!) SHFileOperation operations
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

'(some!) SHFileOperation flags
Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_NOERRORUI As Long = &H400

'(some!) SHFileOperation error codes
Private Const DE_SAMEFILE         As Long = &H71  'The source and destination files are the same file.
Private Const DE_DIFFDIR          As Long = &H73  'Rename operation was specified but the destination path is a different directory. Use the move operation instead.
Private Const DE_ROOTDIR          As Long = &H74  'The source is a root directory, which cannot be moved or renamed.
Private Const DE_OPCANCELLED      As Long = &H75  'The operation was canceled by the user, or silently canceled if the appropriate flags were supplied to SHFileOperation.
Private Const DE_DESTSUBTREE      As Long = &H76  'The destination is a subtree of the source.
Private Const DE_ACCESSDENIEDSRC  As Long = &H78  'Security settings denied access to the source.
Private Const DE_PATHTOODEEP      As Long = &H79  'The source or destination path exceeded or would exceed MAX_PATH.
Private Const DE_MANYDEST         As Long = &H7A  'The operation involved multiple destination paths, which can fail in the case of a move operation.
Private Const DE_INVALIDFILES     As Long = &H7C  'The path in the source or destination or both was invalid.
Private Const DE_DESTSAMETREE     As Long = &H7D  'The source and destination have the same parent folder.
Private Const DE_FLDDESTISFILE    As Long = &H7E  'The destination path is an existing file.
Private Const DE_FILEDESTISFLD    As Long = &H80  'The destination path is an existing folder.
Private Const DE_FILENAMETOOLONG  As Long = &H81  'The name of the file exceeds MAX_PATH.
Private Const DE_ERROR_MAX        As Long = &HB7  'MAX_PATH was exceeded during the operation.
Private Const DE_UNKNOWN          As Long = &H402 'An unknown error occurred. This is typically due to an invalid path in the source or destination. This error does not occur on Windows Vista and later.
Private Const ERRORONDEST         As Long = &H10000 'An unspecified error occurred on the destination.
Private Const DE_ISROOTDIR        As Long = DE_ROOTDIR Or ERRORONDEST 'Destination is a root directory and cannot be renamed.

Public Sub Demo_Move()
  
  Dim strPath As String
  Dim strPathNew As String
  
  With Worksheets("Tabelle1")
    strPath = StrConv("D:\" & .Range("B3") & "\", vbUnicode)
    strPathNew = StrConv("D:\" & .Range("B3") & "_2018\", vbUnicode)
  End With
  
  If Not SHFileFolderRenameW(strPath, strPathNew) Then
    Call MsgBox("Umbenennen fehlgeschalgen.", vbCritical)
'  Else
'    '...
  End If
  
End Sub

'////////////////////////////////////////////////////////////////
'// renames a file or a folder
Public Function SHFileFolderRenameW(ByVal Path As String, ByVal PathNew As String) As Boolean
  
  Const PROC_NAME As String = "SHFileFolderRenameW"
  
  Dim retVal As Long
  Dim udtSHFO As SHFILEOPSTRUCT
  
  With udtSHFO
'    .hWnd = 0
    .wFunc = FO_RENAME
    .fFlags = FOF_NOERRORUI Or FOF_NOCONFIRMATION
    .pFrom = Path & String$(2, vbNullChar)
    .pTo = PathNew & String$(2, vbNullChar)
  End With
  
  retVal = SHFileOperationW(udtSHFO)
  
  Debug.Print Format$(Time, "\#hh:mm:ss\#"); Spc(1); PROC_NAME; Spc(1);
  Select Case retVal
    Case Else: Debug.Print "returned 0x" & Hex$(retVal)
  End Select
  
  SHFileFolderRenameW = (retVal = ERROR_SUCCESS)
  
End Function

Grüße