Unzip y renombrar los archivos que tengan el mismo nombre

<p>Hola:<br />Tengo un problema que no puedo resolver, uso un codigo para descomprimir archivos .zip contenidos en x carpeta,<br />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.<br />Otro detalle el excel de la empresa es 2003 y windows es XP, por ello no puedo renombrarlo como sucede con windows 7.<br />Anexo codigo:</p><p><br />Sub Unzipear()<br />Dim FSO As Object<br />Dim oApp As Object<br />Dim Fname As Variant<br />Dim FileNameFolder As Variant<br />Dim DefPath As String<br />Dim strDate As String<br />Dim I As Long<br />Dim num As Long<br />Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _<br />MultiSelect:=True)<br />'If IsArray(Fname) = False Then<br />'Do nothing<br />'Else<br />'Root folder for the new folder.<br />DefPath = "C:\MOV\"<br />'DefPath = Application.DefaultFilePath<br />'If Right(DefPath, 1) <> "\" Then<br />'DefPath = DefPath & "\"<br />'End If<br />'Create the folder name<br />strDate = Format(Now, " dd-mm-yy h-mm-ss")<br />FileNameFolder = DefPath & "MOV " & strDate & "\"<br />'Make the normal folder in DefPath<br />MkDir FileNameFolder<br />'Extract the files into the newly created folder<br />Set oApp = CreateObject("Shell.Application")<br />For I = LBound(Fname) To UBound(Fname)<br />num = oApp.Namespace(FileNameFolder).items.Count<br />oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(I)).items<br />Next I<br />MsgBox "You find the files here: " & FileNameFolder<br />On Error Resume Next<br />Set FSO = CreateObject("scripting.filesystemobject")<br />FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True<br />'End If<br />End Sub</p>