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