Error al Exportar fechas de Listview en VB6 a Excel

[jeaguiar25]

Buenas gente del Foro!!
Estoy intentando exportar a Excel un Listview. Y estoy teniendo problemas con el archivo generado en la casilla donde se exportan las fechas. He intentado varias maneras y no me resulta. Espero que alguna alma generosa pueda ver el código y decirme donde está el error.
'-----------------------------------------------------------------------

Sub Exportar_Excel3(lsvData As ListView, strHistorial_APACHE_II As String, strArchivo_Historial_APACHE_II As String)
Dim TMP
Dim i, J As Double
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim CellCnt As Double 'contar las celdas
Set xlApp = New Excel.Application 'asignar las referencias a las variables
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlApp.ActiveSheet.PageSetup.CenterHorizontally = True
xlApp.ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.22)
xlApp.ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.18)
xlApp.ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.34)
xlApp.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.34)
xlApp.ActiveSheet.PageSetup.Orientation = xlPortrait
xlApp.ActiveWindow.DisplayGridlines = False
i = 1 '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
CellCnt = 1 'CONTEO DE COLUMNAS
TMP = lsvData.ColumnHeaders.Item(1) ' OBTENER EL HEADER ITEM DEL LISTVEW
For CellCnt = 1 To lsvData.ColumnHeaders.Count
xlSheet.Cells(i, CellCnt) = lsvData.ColumnHeaders(CellCnt).Text
'xlSheet.Cells(i, CellCnt).Interior.ColorIndex = 33
xlSheet.Cells(i, CellCnt).Font.Bold = True
xlSheet.Cells(i, CellCnt).BorderAround xlContinuous
xlSheet.Cells(i, CellCnt).HorizontalAlignment = xlCenter
'xlSheet.Cells(i, CellCnt).
DoEvents
Next

i = 2 '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
CellCnt = 1 'CONTEO DE COLUMNAS
For J = 1 To lsvData.ListItems.Count
TMP = lsvData.ListItems.Item(i - 1) ' OBTENER EL ITEM DEL LISTVEW
xlSheet.Cells(i, 1) = lsvData.ListItems(i - 1)
For CellCnt = 1 To lsvData.ColumnHeaders.Count - 1
xlSheet.Cells(i, CellCnt + 1) = lsvData.ListItems(i - 1).SubItems(CellCnt)
Next

DoEvents
i = i + 1
Next J

xlApp.Range("A5:I" & (lsvData.ListItems.Count + 2)).Sort Key1:=xlSheet.Range("A6"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal 'Ajustar todas las columnas
For J = 1 To lsvData.ColumnHeaders.Count
xlSheet.Columns(J).AutoFit

With xlSheet
.Range("D:D").NumberFormat = "dd/mm/yyyy;@" '"Fecha Nacimiento" = Fecha
End With

Next J 'Salvar la hoja de excel

xlSheet.Name = "APACHE II"

Sheets("Hoja" & 1).Delete
Sheets("Hoja" & 2).Delete
Sheets("Hoja" & 3).Delete

xlSheet.SaveAs "C:\Users\Jose\Desktop\" & "Reporte APACHE II" & " - " & Replace(DateValue(Date), "/", "-") & ".xls"
'Lugar donde se guarda y en formato xlsx
'----------------------------------------------------------------------



MsgBox "Consulta exportada a Excel con éxito!! " & vbNewLine & " La exportación se ha guardado en el Escritorio en formato Excel 2000.", vbInformation
xlBook.Close
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Exit Sub
SaveErr:
If Err.Number <> 32755 Then
MsgBox "Ocurrió un error!!" & vbNewLine & "[ " & Err.Description & " ]", vbExclamation
End If
End Sub

'----------------------------------------------------------------------------------------------
De antemano, Muchas Gracias