Dim Pfad As String
 
Private Sub Form_Load()
Umbenennen.Enabled = False
End Sub
 
Private Sub Umbenennen_Click()
Dim N As Long
On Error GoTo Fehler
 
 Me.Enabled = False
 
 For N = 0 To File1.ListCount - 1
  Name File1.Path & "\" & File1.List(N) As File1.Path & "\" & Format(Trim(CStr( _
    N + 1)), "0000") & Right(File1.Path & "\" & File1.List(N), 4)
 Next
 
 Me.Enabled = True
 
Exit Sub
Fehler:
MsgBox Err.Description
Me.Enabled = True
End Sub
 
Private Sub Ordner_Click()
Pfad = BrowseForFolder("Bitte Ordner wählen", Pfad)
If Pfad <> "" Then
Umbenennen.Enabled = True
File1.Path = Pfad
End If
End Sub

Option Explicit
 
Private Type BrowseInfo
  hWndOwner As Long
  pIDLRoot As Long
  pszDisplayName As Long
  lpszTitle As Long
  ulFlags As Long
  lpfnCallback As Long
  lParam As Long
  iImage As Long
End Type
 
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = 1
 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
  (ByVal hMem As Long)
 
Private Declare Function lstrcat Lib "kernel32" Alias _
  "lstrcatA" (ByVal lpString1 As String, _
  ByVal lpString2 As String) As Long
 
Private Declare Function GetActiveWindow Lib "user32" () As Long
 
Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
  ByVal pidList As Long, _
  ByVal lpBuffer As String) As Long
 
Private Declare Function SHBrowseForFolder Lib "shell32" ( _
  lpbi As BrowseInfo) As Long
 
Private Declare Function SendMessage Lib "user32.dll" _
  Alias "SendMessageA" ( _
  ByVal hWnd As Long, _
  ByVal Msg As Long, _
  wParam As Any, _
  lParam As Any) As Long
 
Private m_BrowseInitDir As String
 
Public Function BrowseForFolder(ByVal sPrompt As String, _
  Optional ByVal sInitDir As String) As String
 
  Dim nPos As Long
  Dim nIDList As Long
  Dim sPath As String
  Dim oInfo As BrowseInfo
 
  m_BrowseInitDir = sInitDir
 
  With oInfo
    .hWndOwner = GetActiveWindow()
    .lpszTitle = lstrcat(sPrompt, "")
    .ulFlags = BIF_RETURNONLYFSDIRS
    If sInitDir <> "" Then
      .lpfnCallback = FuncCallback(AddressOf BrowseCallback)
    End If
  End With
 
  nIDList = SHBrowseForFolder(oInfo)
  If nIDList Then
    sPath = String$(MAX_PATH, 0)
    Call SHGetPathFromIDList(nIDList, sPath)
    Call CoTaskMemFree(nIDList)
    nPos = InStr(sPath, vbNullChar)
    If nPos Then sPath = Left$(sPath, nPos - 1)
  End If
 
  BrowseForFolder = sPath
End Function
 
Private Function BrowseCallback(ByVal hWnd As Long, _
  ByVal uMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
  Select Case uMsg
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, ByVal 1&, _
        ByVal m_BrowseInitDir)
  End Select
  BrowseCallback = 0
End Function
 
Private Function FuncCallback(ByVal nParam As Long) As Long
  FuncCallback = nParam
End Function