Como modificar archivo txt desde excel
Debo abrir un archivo txt desde un archivo excel y copiar información en algunas celdas. El problema que tengo es que la macro, no lee por línea, sino varias y se produce un error al comparar fechas. Para corregir, debo entrar al txt y borrar una línea, con esto la macro se ejecuta correctamente.
Public Sub Cargar() Dim Reg As String, Equipo As String, He As String, Demora As String, Archivo As String Dim Fec1 As String, Fec2 As String, Fecha As Date, Mes As Byte Range("A2:E655").Select: Selection.Clear: Fila = 1: Cells(1, 1).Select Archivo = InputBox("Ingrese fecha archivo horómetros (MMDDAAAA.dat)", "Horómetros Dispatch") On Error Resume Next Open Workbooks(1).Path & "\" & Archivo For Input Access Read As 1 If Err.Number = 55 Then MsgBox "No existe el archivo", vbCritical, "Horómetros Dispatch" Else Do While Not EOF(1)
Line Input #1, Reg Equipo = Trim(Left(Reg, 17))
If InStr(1, Reg, "2 Shifts") <> 0 Then
Fec1 = Mid(Reg, 14, 10): Fec2 = Mid(Reg, 29, 10) If Fec1 <> Fec2
Then MsgBox "El informe contiene más de una fecha", vbCritical, "Horómetros Dispatch"
Else Select Case Mid(Fec1, 5, 3) Case "ENE": Mes = 1 Case "FEB": Mes = 2 Case "MAR": Mes = 3 Case "ABR": Mes = 4 Case "MAY": Mes = 5 Case "JUN": Mes = 6 Case "JUL": Mes = 7 Case "AGO": Mes = 8 Case "SEP": Mes = 9 Case "OCT": Mes = 10 Case "NOV": Mes = 11 Case "DIC": Mes = 12 Case Else: MsgBox "Descripción del mes no reconocido", vbCritical, "Horómetros Dispatch": Exit Do End Select Fecha = DateSerial(2000 + Val(Mid(Fec1, 9, 2)), Mes, Val(Mid(Fec1, 2, 2))) End If ElseIf Len(Trim(Left(Reg, 17))) = 5 Then He = Val(Trim(Mid(Reg, 19, 9))) Demora = Val(Trim(Mid(Reg, 37, 9))) Fila = Fila + 1 Cells(Fila, 1).Value = Fecha Cells(Fila, 2).Value = Equipo Cells(Fila, 3).Value = He Cells(Fila, 4).Value = Demora ElseIf Len(Trim(Left(Reg, 17))) = 6 Then He = Val(Trim(Mid(Reg, 19, 9))) Demora = Val(Trim(Mid(Reg, 29, 9))) Fila = Fila + 1 Cells(Fila, 1).Value = Fecha Cells(Fila, 2).Value = Equipo Cells(Fila, 3).Value = He Cells(Fila, 4).Value = Demora End If Loop Range("A2:E2").Select Selection.Delete Shift:=xlUp MsgBox "Ha terminado la carga", vbInformation, "Horómetros" End If End Sub
Espero me puedas ayudar.
Saludos