Visual Basic - Unzip y renombrar archivos que tengan el mismo nombre

Hola:
Tengo un problema que no puedo resolver, uso un codigo para descomprimir archivos .zip contenidos en x carpeta,
El problema radica que muchos de los archivos .zip aunque se llamen diferente contienen archivos con el mismo nombre y windows me pregunta que la carpeta ya contiene un archivo con el mismo nombre desea sustituirlo, cancelar o aceptar.
Otro detalle el excel de la empresa es 2003 y windows es XP, por ello no puedo renombrarlo como sucede con windows 7.
Anexo codigo:


Sub Unzipear()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim I As Long
Dim num As Long
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=True)
'If IsArray(Fname) = False Then
'Do nothing
'Else
'Root folder for the new folder.
DefPath = "C:\MOV\"
'DefPath = Application.DefaultFilePath
'If Right(DefPath, 1) <> "\" Then
'DefPath = DefPath & "\"
'End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MOV " & strDate & "\"
'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
For I = LBound(Fname) To UBound(Fname)
num = oApp.Namespace(FileNameFolder).items.Count
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(I)).items
Next I
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
'End If
End Sub