Hola alguien necesito pasar una tipo de fecha PubDate (son las que vienen los rss, feed, atom etc) pero bueno mirando un poco vi que tienen muchos formatos diferentes y no se bien si estoy haciendo lo correcto
por el momento hice esta función pero tengo problema con los dos últimos formatos
(2011-06-06T06:16:42+02:00 Y 2011-06-05T21:46:13Z) alguien conoce otra forma o como mejorar esta.
Option Explicit
Private Type TIME_ZONE_INFORMATION
Bias As Long
Reserved(0 To 169) As Byte
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Sub Form_Load()
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 07:57:15 PDT")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 22:06:29 GMT")
Debug.Print PubDateToVBDate("2011-06-05 21:35:26")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 13:52:53 PST")
Debug.Print PubDateToVBDate("2011-06-06T06:16:42+02:00")
Debug.Print PubDateToVBDate("2011-06-05T21:46:13Z")
End Sub
Private Function PubDateToVBDate(ByVal sPubDate As String) As Date
Dim TZI As TIME_ZONE_INFORMATION
Dim sDate As String
Dim lRet As Long
lRet = InStr(sPubDate, ", ")
If lRet Then
sDate = Mid$(sPubDate, InStr(sPubDate, ", ") + 2)
Else
sDate = sPubDate
End If
If InStrRev(sDate, " ") <> InStr(sDate, " ") Then
sDate = Left$(sDate, InStrRev(sDate, " "))
End If
GetTimeZoneInformation TZI
sDate = DateAdd("h", -(TZI.Bias / 60), CDate(sDate))
If InStr(sPubDate, "PDT") Then sDate = DateAdd("h", 7, sDate)
If InStr(sPubDate, "PST") Then sDate = DateAdd("h", 8, sDate)
PubDateToVBDate = sDate
End Function
.
* Ni idea que signifique la Z (http://laz.mx/) pero aquí en México es una estación de radio.
* Lo que esta después de signo de + supongo que son las horas adiciones.
* No tome en consideración combinaciones de formatos ( Ej. Mie, 6 Jul 2005 13:00:00 -0700 ) .
* Esperando que se un formato tipo Timestamp funcionara este código.
* No me apegue mucho a el RFC 2822 (http://www.faqs.org/rfcs/rfc2822.html) ( ya lo habia consultado hace tiempo y aqui viene algo de esta etiqueta aun que no se si me estoy equivoco/confundo), de hecho solo realize el codigo en base a los formatos que has dejado...
Option Explicit
Private Type TIME_ZONE_INFORMATION
Bias As Long
Reserved(0 To 169) As Byte
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Sub Form_Load()
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 07:57:15 PDT")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 22:06:29 GMT")
Debug.Print PubDateToVBDate("2011-06-05 21:35:26")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 13:52:53 PST")
Debug.Print PubDateToVBDate("2011-06-06T06:16:42+02:00")
Debug.Print PubDateToVBDate("2011-06-06T06:16:42-02:00")
Debug.Print PubDateToVBDate("2011-06-05T21:46:13Z")
End Sub
Private Function PubDateToVBDate(ByVal sPubDate As String) As Date
Dim stTZI As TIME_ZONE_INFORMATION
Dim lln As Long
Dim sTagGet As String
Dim sAdd As String
Dim lAdd As Long
Dim llnAdd As Long
GetTimeZoneInformation stTZI
If (UCase(Mid$(sPubDate, 11, 1)) = "T") Then
Mid$(sPubDate, 11, 1) = " "
lln = InStrRev(sPubDate, "+")
If (lln > 0) Then
lAdd = 1
Else
lln = InStrRev(sPubDate, "-")
If (lln > 0) Then
lAdd = (-1)
End If
End If
If (lln > 0) Then
sAdd = Mid$(sPubDate, lln + 1)
llnAdd = Len(sAdd)
If (lAdd = 1) Then
sPubDate = Replace$(sPubDate, "+" & sAdd, "")
Else
sPubDate = Replace$(sPubDate, "-" & sAdd, "")
End If
End If
sTagGet = sPubDate
Mid$(sPubDate, 1, 2) = Mid$(sTagGet, 9, 2) ' // Dia.
Mid$(sPubDate, 3, 1) = " "
Mid$(sPubDate, 4, 2) = Mid$(sTagGet, 6, 2) ' // Mes.
Mid$(sPubDate, 6, 1) = " "
Mid$(sPubDate, 7, 4) = Mid$(sTagGet, 1, 4) ' // Año.
lln = Len(sPubDate)
If (lln > 19) Then
sPubDate = Left$(sPubDate, 19)
End If
If (llnAdd > 0) Then
If (llnAdd >= 2) Then
sPubDate = DateAdd("h", Val(Mid$(sAdd, 1, 2)) * lAdd, CDate(sPubDate)) ' // Horas
End If
If (llnAdd >= 5) Then
sPubDate = DateAdd("m", Val(Mid$(sAdd, 4, 2)) * lAdd, CDate(sPubDate)) ' // Minutos
End If
If (llnAdd >= 8) Then
sPubDate = DateAdd("s", Val(Mid$(sAdd, 7, 2)) * lAdd, CDate(sPubDate)) ' // Segundos
End If
End If
Else
lln = Len(sPubDate)
sTagGet = Right$(sPubDate, 3)
sPubDate = Mid$(sPubDate, InStr(sPubDate, ", ") + 2)
sPubDate = Left$(sPubDate, InStrRev(sPubDate, " ") - 1)
sPubDate = DateAdd("h", -(stTZI.Bias / 60), CDate(sPubDate))
Select Case sTagGet
Case "PDT"
sPubDate = DateAdd("h", 7, sPubDate)
Case "PST"
sPubDate = DateAdd("h", 8, sPubDate)
'Case "GMT"
' // No se que hacer xP...
End Select
End If
PubDateToVBDate = CDate(sPubDate)
End Function
Temibles Lunas!¡.
Hola gracias, por lo que creo la Z es lo mismo que tu nick Zero osea 0, segui buscando y encontre otros formatos mas asi que reize la funcion, la funcion que vos hisiste tiene un problema al obtener la fecha utilizando mid() ya que si esta en el formato norteamericano ponen el año primero.
Option Explicit
Private Type TIME_ZONE_INFORMATION
Bias As Long
Reserved(0 To 169) As Byte
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Sub Form_Load()
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 07:57:15 PDT")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 22:06:29 GMT")
Debug.Print PubDateToVBDate("Mon, 06 Jun 2011 14:47:05 EDT")
Debug.Print PubDateToVBDate("Sun, 05 Jun 2011 13:52:53 PST")
Debug.Print PubDateToVBDate("2011-06-05 21:35:26")
Debug.Print PubDateToVBDate("8/7/2010 12:16:37 AM")
Debug.Print PubDateToVBDate("8/6/2010 11:46:33 PM")
Debug.Print PubDateToVBDate("6/6/2011 11:35:14 PM GMT")
Debug.Print PubDateToVBDate("Wed, 27 Apr 2011 18:26:06 +0000")
Debug.Print PubDateToVBDate("Wed, 27 Apr 2011 18:26:06 +0200")
Debug.Print PubDateToVBDate("2011-06-06T06:16:42+02:00")
Debug.Print PubDateToVBDate("2011-06-06T06:16:42-02:00")
Debug.Print PubDateToVBDate("2011-06-06T05:40:00Z")
Debug.Print PubDateToVBDate("2011-06-06T17:45:23+00:00")
End Sub
Private Function PubDateToVBDate(ByVal sPubDate As String) As Date
Dim tTZI As TIME_ZONE_INFORMATION
Dim lRet As Long
Dim TDelay As String
Dim sSimbol As String
Dim sHour As String
Dim sMinute As String
Dim ArrMonthEnglish As Variant
Dim I As Long
GetTimeZoneInformation tTZI
sPubDate = UCase(sPubDate)
ArrMonthEnglish = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
For I = 0 To 11
sPubDate = Replace(sPubDate, CStr(ArrMonthEnglish(I)), I + 1)
Next
If IsDate(sPubDate) Then
PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
Exit Function
End If
lRet = InStr(sPubDate, ", ")
If lRet Then
sPubDate = Mid(sPubDate, lRet + 2)
End If
If IsDate(sPubDate) Then 'por las dudas
PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
Exit Function
End If
lRet = InStr(sPubDate, " ")
If lRet = 0 Then
sPubDate = Replace(sPubDate, "T", " ")
If Right(sPubDate, 1) = "Z" Then
sPubDate = Replace(sPubDate, "Z", "+00:00")
End If
TDelay = Replace(Right$(sPubDate, 6), ":", "")
sPubDate = Left$(sPubDate, Len(sPubDate) - 6)
Else
Select Case Right(sPubDate, 3)
Case "GMT": TDelay = "+0000"
Case "EDT": TDelay = "-0400"
Case "CDT", "EST": TDelay = "-0500"
Case "CST", "MDT": TDelay = "-0600"
Case "MST", "PDT": TDelay = "-0700"
Case "PST", "ADT": TDelay = "-0800"
Case "AST", "HDT": TDelay = "-0900"
Case "HDT": TDelay = "-1000"
End Select
If Len(TDelay) Then
sPubDate = Left(sPubDate, Len(sPubDate) - 4)
Else
TDelay = Right(sPubDate, 5)
sPubDate = Left(sPubDate, Len(sPubDate) - 6)
End If
End If
If IsDate(sPubDate) Then
sSimbol = Left$(TDelay, 1)
sHour = Mid$(TDelay, 2, 2)
sMinute = Right$(TDelay, 2)
If IsNumeric(sHour) And IsNumeric(sMinute) Then
If sSimbol = "+" Then
sPubDate = DateAdd("h", -Val(sHour), CDate(sPubDate))
sPubDate = DateAdd("m", -Val(sMinute), CDate(sPubDate))
ElseIf sSimbol = "-" Then
sPubDate = DateAdd("h", Val(sHour), CDate(sPubDate))
sPubDate = DateAdd("m", Val(sMinute), CDate(sPubDate))
End If
PubDateToVBDate = DateAdd("h", -(tTZI.Bias / 60), CDate(sPubDate))
End If
End If
End Function
creo que no hay mas variantes, si alguno encuentra algo que avise.
Saludos
La Z proviene de Estandar ISO para fechas (http://es.wikipedia.org/wiki/ISO_8601)
Despues veo si puedo ayudar en la funcion :P