Option Explicit
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal _
  hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_DELETESTRING = &H182
 
Private Sub Dir1_Change()
 
    Dim i As Long
    For i = 1 To Len(Dir1.Path)
    If Mid$(Dir1.Path, i, 1) = "\" Then
        SendMessage Dir1.hwnd, LB_DELETESTRING, 0&, ByVal 0&
    End If
    Next i
 
End Sub

Ohne Mampf, kein Kampf !