Consulta Restar horas GTM al exportar de sql a excel

[jmerlos282]

Buen día compañeros espero que se encuentren bien,

Dejo mi post para ver si alguien me puede dar luz con este tema, el cual es el siguiente:

Una aplicación externa guardo cierta información en una BD de SQL y por limitantes con VB6 exporto esos datos a excel, el problema es que la aplicación exporta las fechas que es una de la información que uso en formato de 0 GTM, es decir, no le importa en que país o si usas el horario de verano, etc,.

El detalle que el horario para esta empresa es muy importante por la información que manejan, pero le he buscado y rebuscado y no encuentro como puedo aplicarle un + 6 hrs a las celdas donde vienen las fechas para que muestre correctamente el horario.

De antemano agradezco el apoyo

Código vb:

Public Sub rep_Alarmas()
On Error Resume Next
  Dim area As String
    
    Inicio_Consulta
     
Set Consulta = New ADODB.Recordset
    Consulta.Open Comando, Conexion
If Not Consulta.EOF Then
 filename = rsTocsv(Consulta, "C:\Reportes_Generales\Historico_Alarmas_" & VBA.Format(Now, "ddmmyy hhmmss") & ".xlsx", True)
    
 Barras "Recolectando Registros de Alarmas...", 30 * 3.46
'Abrir plantilla de excel
On Error GoTo Error_NoExiste 'Mandar Mensaje de Error de que no existe Archivo
     Set Excelapp = CreateObject("Excel.Application") 'loads and instance of Excel in memory
     Excelapp.Workbooks.Open (filename) 'Abrir"
 
'--------Llenar tabla de excel con los datos encontrados
DoEvents
 Barras "Exportando Datos a Archivo de Excel...", 60 * 3.46
    With Excelapp
 
'--------------------Mover los datos a la columna requerida
     .Worksheets(1).Range("D1").Select
     .Worksheets(1).Range(.Selection, .Selection.End(xlDown)).Cut
     .Worksheets(1).Range("G2").Select
     .ActiveSheet.Paste
     .Worksheets(1).Range("C1").Select
     .Worksheets(1).Range(.Selection, .Selection.End(xlDown)).Cut
     .Worksheets(1).Range("E2").Select
     .ActiveSheet.Paste
     .Worksheets(1).Range("B1").Select
     .Worksheets(1).Range(.Selection, .Selection.End(xlDown)).Cut
     .Worksheets(1).Range("C2").Select
     .ActiveSheet.Paste
     .Worksheets(1).Range("A1").Select
     .Worksheets(1).Range(.Selection, .Selection.End(xlDown)).Cut
     .Worksheets(1).Range("A2").Select
     .ActiveSheet.Paste
 
'--------------------dar formato a las columnas
    .Worksheets(1).Columns("A:A").ColumnWidth = 12.86
    .Worksheets(1).Columns("C:C").ColumnWidth = 24.14
    .Worksheets(1).Columns("E:E").ColumnWidth = 78.29
    .Worksheets(1).Columns("G:G").ColumnWidth = 33.71
    .Worksheets(1).Columns("B:B").ColumnWidth = 1
    .Worksheets(1).Columns("D:D").ColumnWidth = 1
    .Worksheets(1).Columns("F:F").ColumnWidth = 1
    .Worksheets(1).Rows("1:1").RowHeight = 52.5
    .Worksheets(1).Range("A:A").HorizontalAlignment = xlRight
    .Worksheets(1).Range("B2:C2").Merge
    .Worksheets(1).Range("D2:E2").Merge
    .Worksheets(1).Range("F2:G2").Merge
    .Worksheets(1).Range("A2:F2").Select
    With .Selection
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlThin
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
    End With
    .Worksheets(1).Range("E1:E1").HorizontalAlignment = xlRight
    .Worksheets(1).Range("G1:G1").HorizontalAlignment = xlLeft
 
'--------------------Escribir fecha del Reporte
    .Worksheets(1).Range("E1").Value = "Fecha: "
    .Worksheets(1).Range("F1").Value = VBA.Format(ThisDisplay.datestart, "DD/MM/YYYY")
 
'--------------------Ponemos logo del cliente
    .Worksheets(1).Range("A1").Select
    .ActiveSheet.Pictures.Insert("Ruta").Select
   End With
   DoEvents
 
' Barras "Exportando Datos a Archivo de Excel...", (renglon * (35 / totallineas)) * 3.46 + (60 * 3.46), renglon * (35 / totallineas) + 60
 Barras "Exportando Datos a Archivo de Excel...", (80 * 3.46)
        
           Else
            MsgBox "No se encontraron datos en la busqueda...", vbInformation, "No hay datos"
            Objetos True
           GoTo Salir
           End If
 Cerrar_conexionSQL
guardar:
        DoEvents
 Barras "Exportando Datos a Archivo de Excel...", 100 * 3.46
          Excelapp.ActiveWorkbook.Save
        Excelapp.Quit
       Set Excelapp = Nothing
          MsgBox "El Reporte Fue Creado con  Exito en:" & VBA.Chr(13) & _
           filename, vbInformation, " Status del Reporte"
     Objetos True
 ThisDisplay.crearRep.Visible = True
    Exit Sub
Salir:
 Cerrar_conexionSQL
 Objetos True
 ThisDisplay.crearRep.Visible = True
    Exit Sub
 
'Errores al obtener tags
Error_NoExiste:
    MsgBox "Error en Archivo." & VBA.Chr(13) & _
           "Verifique que la siguiente ruta existe: Ruta" & VBA.Chr(13) & VBA.Err.Description, VBA.vbCritical, "Error en Ruta de Archivo..."
           GoTo Salir
  Exit Sub
 
'Errores Durante la Creacion del Reporte
Error_BaseDatos:
    MsgBox "Error con Base de Datos" & VBA.Chr(13) & _
           "Error de Sistema: " & VBA.Chr(13) & VBA.Err.Description, VBA.vbCritical, "Error Conexion con Base de Datos"
           GoTo Salir
 
End Sub
 

[Malenko]

Y te valdría que se sumara las 6 horas en el momento de lanzar al consulta para traer los datos al Excel? Si es así, podrías poner la consulta que usas (no está en el código que has puesto), o si lo quieres usar tu mismo, prueba con DateAdd.

[jmerlos282]

Iniciado por Malenko

Y te valdría que se sumara las 6 horas en el momento de lanzar al consulta para traer los datos al Excel? Si es así, podrías poner la consulta que usas (no está en el código que has puesto), o si lo quieres usar tu mismo, prueba con [URL="http://msdn.microsoft.com/es-es/library/ms186819.aspx"]DateAdd[/URL].

Gracias amigo mira tengo varias consultas, las cuales te dejo abajo, nunca he usado este DateAdd déjame le voy dando una leída. Si vez algunas funciones no conocidas es por la conexión especifica con la aplicación que te comento.

Código vb:

Public Sub Inicio_Consulta()
' Fecha inicial 1 dia menos y fecha final 1 dia mas para sacar todas las muestras del dia
  ThisDisplay.datestart = VBA.Format(ThisDisplay.Finicial.Value, "yyyy/mm/dd") & " 00:00:00"
  ThisDisplay.dateend = VBA.Format(ThisDisplay.Finicial.Value, "yyyy/mm/dd") & " 23:59:59"
      Barras "Iniciando Busqueda...", 10
     DoEvents
      Objetos False
      ThisDisplay.crearRep.Visible = False
      ThisDisplay.Status1.ForeColor = vbBlack
End Sub
 

Código vb:

Public Sub consultaSQL(ByVal cSQL As String)
    'abrir la conexion
  On Error GoTo Error_BaseDatos
   DoEvents
    Dim CnSQL As ADODB.Connection
    Set CnSQL = New ADODB.Connection
    Set Conexion = New ADODB.Connection
    CnSQL.CommandTimeout = 10000
    CnSQL.Open ThisDisplay.iSQLconex
    Comando = cSQL
         'Consulta
    Set Consulta = New ADODB.Recordset
   DoEvents
    Consulta.Open Comando, CnSQL
Exit Sub
'Errores Durante la Creacion del Reporte
Error_BaseDatos:
    MsgBox "Error con Base de Datos" & VBA.Chr(13) & _
           "Error de Sistema: " & VBA.Chr(13) & VBA.Err.Description, VBA.vbCritical, "Error Conexion con Base de Datos"
End Sub
 

Código vb:

Public Sub sacafechas(ByVal nhini As Date, ByVal nhfin As Date)
 On Error Resume Next
Dim intervalo As Integer
 Dim n As Integer
 Dim h, i, j As Date
  n = 3
  intervalo = 5
 With ThisDisplay.General_Tags
 '*-*-*-*-*-Crear Fechas para Busqueda y Tabla *-*-*-*-*
      i = 0
'      intervalo = Val(intervalo)
'      intervalo = Abs(intervalo)
      If intervalo = 0 Then intervalo = 1
    StringFechas = "("
  Do
   .Cols = n + 1
   h = VBA.Format(nhini + i, "DD/MM/YYYY HH:mm:ss")
    If h > nhfin Then h = VBA.Format(nhfin, "DD/MM/YYYY HH:mm:ss")
 '  .ColDisplayFormat(n) = "DD/MM/YYYY HH:mm:ss"
   .TextMatrix(3, n) = VBA.Format(h, "DD/MM/YYYY")
   .TextMatrix(4, n) = VBA.Format(h, "HH:mm:ss")
     If .Cols > 4 Then StringFechas = StringFechas & "' OR "
   j = DateAdd("n", 5, h)
     StringFechas = StringFechas & " DateAndTime >  '" & VBA.Format(h, "yyyy/mm/dd hh:mm:ss") & "' And DateAndTime <  '" & VBA.Format(j, "yyyy/mm/dd hh:mm:ss")
   i = DateAdd("n", intervalo, i)
   n = n + 1
  Loop While Not h = nhfin
    StringFechas = StringFechas & "')"
 End With
End Sub