Private Sub Importar_TXT()
Dim xtiene_en_cuenta_metodo As Boolean
Dim intCodigoInicio As Integer
Dim intCodigoCantidad As Integer
Dim intDeterminacionInicio As Integer
Dim intDeterminacionCantidad As Integer
Dim intValorInicio As Integer
Dim intValorCantidad As Integer
Dim intMetodoInicio As Integer
Dim intMetodoCantidad As Integer
xtiene_en_cuenta_metodo = Not esVer(bd("notieneencuentametodo", "lab_Area", "IdArea=" & mDblArea))
intCodigoInicio = num(bd("ImportacionInicioNroProt", "lab_Area", "IdArea=" & mDblArea))
intCodigoCantidad = num(bd("ImportacionCantidadNroProt", "lab_Area", "IdArea=" & mDblArea))
intDeterminacionInicio = num(bd("ImportacionInicioDeterminacion", "lab_Area", "IdArea=" & mDblArea))
intDeterminacionCantidad = num(bd("ImportacionCantidadDeterminacion", "lab_Area", "IdArea=" & mDblArea))
intValorInicio = num(bd("ImportacionInicioValor", "lab_Area", "IdArea=" & mDblArea))
intValorCantidad = num(bd("ImportacionCantidadValor", "lab_Area", "IdArea=" & mDblArea))
intMetodoInicio = num(bd("ImportacionInicioMetodo", "lab_Area", "IdArea=" & mDblArea))
intMetodoCantidad = num(bd("ImportacionCantidadMetodo", "lab_Area", "IdArea=" & mDblArea))
Dim strArchivos As String
Dim strCarpeta As String
Dim intFH As Long
strCarpeta = mStrCarpetaImportacionArea
If (strCarpeta = "") Then
strCarpeta = mStrCarpetaImportacion
End If
If (strCarpeta = "") Then
strCarpeta = gStrRaizLogs
End If
With Me.cmmTXTAbrir
.CancelError = True
.FileName = "*.txt"
.Filter = "txt"
.InitDir = strCarpeta
On Error GoTo CanceloArchivo
.ShowOpen
On Error GoTo 0
strArchivos = .FileName
End With
mStrDetalle = ""
If (strArchivos <> "") Then
Me.MousePointer = 11
Dim recDetermacionFormulas As Recordset
Dim recDetermacion As Recordset
Dim mTabla As New modiftabla
Dim bolSigoRecorriendo As Boolean
Dim bolActualizar As Boolean
Dim lngIdDeterminacion As Long
Dim lngIdProtocolo As Long
Dim lngIdAnalisis As Long
Dim dblValor As Double
Dim intTipoValor As Integer
Dim intHasta As Integer
Dim intDesde As Integer
Dim intFila As Integer
Dim strDeterminacionFormula As String
Dim strDeterminacion As String
Dim strCondicion As String
Dim strAnalisis As String
Dim strColumna As String
Dim strCodigo As String
Dim strDatos As String
Dim strFecha As String
Dim strCampo As String
Dim strValor As String
mBolExcelEstaVisible = False
mIntProceso = 0
intFH = FreeFile
Open strArchivos For Input As #intFH
bolActualizar = False
'CARGO DATOS EN REMITO
Me.MousePointer = 11
Do While Not EOF(intFH)
Dim Fila_Archivo As String
Line Input #intFH, Fila_Archivo
intTipoValor = 0
intFila = 0
strMetodo = ""
Dim xerror_en_protocolo As Boolean
xerror_en_protocolo = False
If (mBolImportaExportaResultadosDeMaquinaKX21Cobas111) Then
bolActualizar = IIf(Fila_Archivo <> "", True, False)
Set mColDeterminaciones = New Collection
Set mColDeterminacionesValores = New Collection
ElseIf (mBolImportaExportaResultadosDeMaquinaProtocoloAnalisisPosicionValor) Then
'''PROTOCOLO
bolActualizar = IIf(Fila_Archivo <> "", True, False)
intDesde = 1
intHasta = fncHasta_Enter(Fila_Archivo, 1)
If (intCodigoInicio > 0) And (intCodigoCantidad > 0) Then
strCodigo = Trim(nonul(Mid(Fila_Archivo, intCodigoInicio, intCodigoCantidad)))
Else
strCodigo = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
strDatos = stragr(strDatos, strCodigo, " - ")
'''CODIGO DE INTERNO DE ANALISIS
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
strAnalisis = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
strDatos = stragr(strDatos, strAnalisis, " - ")
'''POSICION DE DETERMINACION (ESTUDIO PARA MAQUINA)
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
If (intDeterminacionInicio > 0) And (intDeterminacionCantidad > 0) Then
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDeterminacionInicio, intDeterminacionCantidad)))
Else
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
strDatos = stragr(strDatos, strDeterminacion, " - ")
'''VALOR
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
If (intValorInicio > 0) And (intValorCantidad > 0) Then
strValor = num(Mid(Fila_Archivo, intValorInicio, intValorCantidad))
Else
strValor = num(Mid(Fila_Archivo, intDesde, intHasta - intDesde))
End If
strDatos = stragr(strDatos, strValor, " - ")
If Not ((strValor = "") _
And (strDeterminacion = "") _
And (strAnalisis = "") _
And (strCodigo = "")) Then
bolActualizar = True
Else
bolActualizar = False
End If
Else
If (mIntTipoImportacionExportacion = 0) _
And (mIntImportaExportaFormato = 1) Then
If (InStr(1, UCase(Fila_Archivo), "DATE") <> 0) Then
strFecha = Replace(Mid(Fila_Archivo, 6, 15), " ", "")
strDatos = stragr(strDatos, strFecha, vbCrLf)
ElseIf (InStr(1, UCase(Fila_Archivo), "PROTOCOLO") <> 0) Then
If (intCodigoInicio > 0) And (intCodigoCantidad > 0) Then
strCodigo = Trim(nonul(Mid(Fila_Archivo, intCodigoInicio, intCodigoCantidad)))
Else
strCodigo = num(Mid(Fila_Archivo, 11, 10), 0)
End If
strDatos = stragr(strDatos, strFecha, " - ")
ElseIf (Trim(Fila_Archivo) <> "") Then
intDesde = 1
intHasta = fncHasta_Numero(Fila_Archivo, intDesde)
If (intDeterminacionInicio > 0) And (intDeterminacionCantidad > 0) Then
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDeterminacionInicio, intDeterminacionCantidad)))
Else
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
strDatos = stragr(strDatos, strDeterminacion, " - ")
intDesde = intHasta
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
If (intValorInicio > 0) And (intValorCantidad > 0) Then
strValor = num(Mid(Fila_Archivo, intValorInicio, intValorCantidad))
Else
strValor = num(Mid(Fila_Archivo, intDesde, intHasta - intDesde), 0)
End If
strDatos = stragr(strDatos, strValor, " - ")
mColDeterminaciones.Add strDeterminacion
--------------->>>>>> mColDeterminacionesValores.Add strValor, Key:=strDeterminacion --------------------------------------->>>>> ACA DA EL ERROR
End If
Else
If (mIntTipoImportacionExportacion = 0) Then
intDesde = 1
intHasta = fncHasta_Enter(Fila_Archivo, 1)
Else
strFecha = Mid(Fila_Archivo, 1, 10)
intDesde = 12
intHasta = fncHasta_Enter(Fila_Archivo, 12)
End If
If (intCodigoInicio > 0) And (intCodigoCantidad > 0) Then
strCodigo = Trim(nonul(Replace(Replace(Mid(Fila_Archivo, intCodigoInicio, intCodigoCantidad), "M", ""), "H", "")))
Else
strCodigo = Trim(nonul(Replace(Replace(Mid(Fila_Archivo, intDesde, intHasta - intDesde), "M", ""), "H", "")))
End If
If (mIntTipoImportacionExportacion = 1) Then
If (strCodigo = "ORI") Then
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
strCodigo = Trim(nonul(Replace(Replace(Mid(Fila_Archivo, intDesde, intHasta - intDesde), "M", ""), "H", "")))
End If
Else
If Not (IsNumeric(strCodigo)) Then lngIdProtocolo = 0
End If
If (mIntTipoImportacionExportacion = 0) Then
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
Else
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
End If
If (intDeterminacionInicio > 0) And (intDeterminacionCantidad > 0) Then
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDeterminacionInicio, intDeterminacionCantidad)))
Else
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
If xtiene_en_cuenta_metodo Then
strMetodo = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
intDesde = intHasta + 1
intHasta = fncHasta_Enter(Fila_Archivo, intDesde)
If (intValorInicio > 0) And (intValorCantidad > 0) Then
strValor = Trim(nonul(Mid(Fila_Archivo, intValorInicio, intValorCantidad)))
Else
strValor = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
End If
If (mIntTipoImportacionExportacion = 0) _
And (mIntImportaExportaFormato = 1) Then
If (Trim(Fila_Archivo) <> "") Then
bolActualizar = False
Else
bolActualizar = IIf(mColDeterminaciones.Count > 0, True, False)
If (bolActualizar) Then
bolActualizar = IIf(Not ((strValor = "") _
And (strCodigo = "")), _
True, _
False)
End If
If (Not bolActualizar) Then
Set mColDeterminacionesValores = New Collection
Set mColDeterminaciones = New Collection
strDeterminacion = ""
strCodigo = ""
strFecha = ""
strValor = ""
intDesde = 0
intHasta = 0
End If
End If
Else
If (Not ((strValor = "") _
And (strDeterminacion = "") _
And (strCodigo = "")) _
And ((mIntTipoImportacionExportacion = 0) _
Or ((mIntTipoImportacionExportacion = 1) _
And IsDate(strFecha)))) Then
bolActualizar = True
Else
bolActualizar = False
End If
End If
End If
If (bolActualizar) Then
If (mBolImportaExportaResultadosDeMaquinaKX21Cobas111) Then
Dim bolError As Boolean
'''PROTOCOLO
intDesde = 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
If (intCodigoInicio > 0) And (intCodigoCantidad > 0) Then
strCodigo = Trim(nonul(Mid(Fila_Archivo, intCodigoInicio, intCodigoCantidad)))
Else
strCodigo = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
'''DETERMINACION
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
While (intHasta <> 0)
If (intDeterminacionInicio > 0) And (intDeterminacionCantidad > 0) Then
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDeterminacionInicio, intDeterminacionCantidad)))
Else
strDeterminacion = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
'''VALOR
If (strDeterminacion <> "") Then
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
If (intValorInicio > 0) And (intValorCantidad > 0) Then
strValor = Trim(nonul(Mid(Fila_Archivo, intValorInicio, intValorCantidad)))
Else
strValor = Trim(nonul(Mid(Fila_Archivo, intDesde, intHasta - intDesde)))
End If
bolError = True
'''AGREGAR DETERMINACION
On Error GoTo Error_Al_Agregar_Valor_A_La_Collecion
mColDeterminacionesValores.Add strValor, Key:=strDeterminacion
On Error GoTo 0
mColDeterminaciones.Add strDeterminacion
bolError = False
Error_Al_Agregar_Valor_A_La_Collecion:
If (bolError) Then
mStrDetalle = stragr(mStrDetalle, "La determinación con código " & strDeterminacion & " y valor " & strValor & " está repetido para el protocolo protocolo Nº" & strCodigo & ".", vbCrLf & vbCrLf)
mIntProceso = 5
End If
intDesde = intHasta + 1
intHasta = fncHasta_Punto_Y_Coma(Fila_Archivo, intDesde)
Else
intHasta = 0
End If
Wend
'If (mBolImportaExportaResultadosDeMaquinaKX21Cobas111) Then
' strCodigo = num(bd("IdProtocolo", "Lab_Protocolo_Analisis", "Numero=" & num(strCodigo, 0)), 0)
'End If
strCodigo = num(strCodigo, 0)
Actualizar_Protocolo strCodigo
Else
If (mIntTipoImportacionExportacion = 0) _
And (mIntImportaExportaFormato = 1) Then
If (mBolImportaExportaResultadosDeMaquinaKX21Cobas111) Then
strCodigo = num(bd("IdProtocolo", "Lab_Protocolo_Analisis", "Numero=" & strCodigo), 0)
End If
Actualizar_Protocolo strCodigo
Else
lngIdAnalisis = 0
If (mBolImportaExportaResultadosDeMaquinaProtocoloAnalisisPosicionValor) Then
If (mBolImportaExportaResultadosDeMaquinaKX21Cobas111) Then
lngIdProtocolo = num(bd("IdProtocolo", "Lab_Protocolo_Analisis", "Numero=" & strCodigo), 0)
Else
lngIdProtocolo = CLng(strCodigo)
End If
lngIdAnalisis = CLng(num(bd("idAnalisis", "Lab_Analisis", IIf(BUSCAR_PARAMETRO("LABORATORIO15D2", "NO") = "SI", "CodFact", "CodInterno") & "='" & strAnalisis & "'")))
If (lngIdAnalisis = 0) Then
lngIdProtocolo = 0
End If
Else
If (mIntTipoImportacionExportacion = 0) _
And (gBolProtocolosDelaboratoriosConNumerosPorPeriodos) Then
strCondicion = "NumeroPeriodo=" & strCodigo
Else
If (mIntTipoImportacionExportacion = 1) Then
strCondicion = "Fecha=" & DB_Fecha_Consulta(CDate(strFecha)) & " " & _
"AND Numero_Orden=" & strCodigo
Else
If (mBolImportaExportaResultadosDeMaquinaKX21Cobas111) Or (mIntTipoImportacionExportacion = 0) Then
If (IsNumeric(strCodigo)) Then
lngIdProtocolo = num(bd("IdProtocolo", "Lab_Protocolo_Analisis", "Numero=" & strCodigo), 0)
End If
Else
lngIdProtocolo = CLng(strCodigo)
End If
End If
End If
If (lngIdProtocolo = 0) And (strCondicion <> "") Then
lngIdProtocolo = CLng(num(Buscar_Datos("SELECT IdProtocolo " & _
"FROM Lab_Protocolo_Analisis " & _
"WHERE " & strCondicion)))
End If
End If
If (lngIdProtocolo <> 0) Then
Dim bolEncontro As Boolean
bolEncontro = False
'Realizo la busqueda de que determinacion es la que tengo que cambiar
If strDeterminacion <> "" Then
If strMetodo <> "" Then
Set recDetermacion = DB_Traer_Tabla("SELECT IdDeterminacion, TipoDeValor, IdAnalisis, descripcion " & _
"FROM Lab_Determinaciones " & _
"WHERE Codigo='" & strDeterminacion & " " & strMetodo & "' " & _
IIf(mBolImportaExportaResultadosDeMaquinaProtocoloAnalisisPosicionValor, "AND IdAnalisis=" & lngIdAnalisis, ""))
ElseIf (BUSCAR_PARAMETRO("LABORATORIO15D2", "NO") = "SI") And mBolImportaExportaResultadosDeMaquinaProtocoloAnalisisPosicionValor Then
Set recDetermacion = DB_Traer_Tabla("SELECT IdDeterminacion, TipoDeValor, IdAnalisis, descripcion FROM Lab_Determinaciones WHERE Posicion=" & strDeterminacion & " AND IdAnalisis=" & lngIdAnalisis)
Else
Set recDetermacion = DB_Traer_Tabla("SELECT IdDeterminacion, TipoDeValor, IdAnalisis, descripcion FROM Lab_Determinaciones WHERE MaquinaEstudioNombre='" & strDeterminacion & "' " & _
IIf(mBolImportaExportaResultadosDeMaquinaProtocoloAnalisisPosicionValor, "AND IdAnalisis=" & lngIdAnalisis, ""))
End If
If Not (recDetermacion.EOF _
And recDetermacion.BOF) Then
xerror_en_protocolo = True
Do While Not (recDetermacion.EOF)
If (CDbl(num(bd("IdProtocolo", "Lab_Protocolo_Det", "IdProtocolo=" & lngIdProtocolo & " AND IdDeterminacion=" & num(recDetermacion!IdDeterminacion, 0)))) <> 0) Then
lngIdDeterminacion = CLng(num(recDetermacion!IdDeterminacion))
intTipoValor = CInt(num(recDetermacion!TipoDeValor))
lngIdAnalisis = CLng(num(recDetermacion!IdAnalisis))
strDeterminacionFormula = nonul(recDetermacion!descripcion)
bolEncontro = True
xerror_en_protocolo = False
Exit Do
End If
recDetermacion.MoveNext
Loop
recDetermacion.Close
End If
End If
If Not (bolEncontro) Then
strDeterminacionFormula = ""
lngIdDeterminacion = 0
intTipoValor = 0
lngIdAnalisis = 0
End If
Set recDetermacion = Nothing
If (lngIdDeterminacion <> 0) Then
If (CDbl(num(bd("IdProtocolo", _
"Lab_Protocolo_Det", _
"IdProtocolo=" & lngIdProtocolo & " " & _
"AND IdDeterminacion=" & lngIdDeterminacion))) <> 0) Then
strValor = Replace(strValor, ",", ".")
strValor = num(strValor, IIf(BUSCAR_PARAMETRO("LABORATORIO15D2", "NO") = "SI" And mBolImportaExportaResultadosDeMaquinaProtocoloAnalisisPosicionValor, 2, 4))
dblValor = CDbl(strValor)
Select Case intTipoValor
Case 0:
strCampo = "ValorNumero"
Case 1:
strCampo = "ValorTexto"
Case 2:
strCampo = "ValorFormula"
End Select
With mTabla
.nombre_tabla = "Lab_Protocolo_Det"
.condicion = "IdProtocolo=" & lngIdProtocolo & " " & _
"AND IdDeterminacion=" & lngIdDeterminacion
.agregarle_campo(strCampo) = IIf(intTipoValor = 0, num(dblValor, num(bd("CantDecimales", "Lab_Determinaciones", "IdDeterminacion=" & lngIdDeterminacion), 0), True), strValor)
.agregarle_campo("Realizado") = True
.agregarle_campo("IdEstadoAnalisis") = 6 'Completo
.agregarle_campo("IdUsuarioCarga") = xUS_IdUsuario
.agregarle_campo("horacarga") = nonul(chora(Time))
.agregarle_campo("fechacarga") = CDate(cfech(date))
.agregarle_campo("ImportadoMaquina") = True
.modificar_tabla
ActualizaEstadoProtocolo CDbl(lngIdProtocolo), CDbl(lngIdAnalisis)
If (intTipoValor = 0) _
And (lngIdAnalisis <> 0) Then
Set recDetermacionFormulas = DB_Traer_Tabla("SELECT IdDeterminacion, Formula " & _
"FROM Lab_Determinaciones " & _
"WHERE IdAnalisis=" & lngIdAnalisis & " AND TipoDeValor=2")
If Not (recDetermacionFormulas.EOF _
And recDetermacionFormulas.BOF) Then
While Not (recDetermacionFormulas.EOF)
strValor = nonul(recDetermacionFormulas!Formula)
If (InStr(1, strValor, strDeterminacionFormula) > 0) Then
lngIdDeterminacion = CLng(num(recDetermacionFormulas!IdDeterminacion))
strValor = Valor_Formula_Determinacion_Calcula(lngIdDeterminacion, _
lngIdProtocolo, _
lngIdAnalisis)
.nombre_tabla = "Lab_Protocolo_Det"
.condicion = "IdProtocolo=" & lngIdProtocolo & " " & _
"AND IdDeterminacion=" & lngIdDeterminacion
.agregarle_campo("ValorFormula") = strValor
.agregarle_campo("Realizado") = True
.agregarle_campo("IdEstadoAnalisis") = 6 'Completo
.agregarle_campo("IdUsuarioCarga") = xUS_IdUsuario
.agregarle_campo("horacarga") = nonul(chora(Time))
.agregarle_campo("fechacarga") = CDate(cfech(date))
.agregarle_campo("ImportadoMaquina") = True
.modificar_tabla
ActualizaEstadoProtocolo CDbl(lngIdProtocolo), CDbl(lngIdAnalisis)
End If
recDetermacionFormulas.MoveNext
Wend
recDetermacionFormulas.Close
End If
Set recDetermacionFormulas = Nothing
End If
If (.No_Hubo_Error) Then
If (mIntProceso <> 5) Then
mIntProceso = 2
End If
Else
mStrDetalle = stragr(mStrDetalle, "Ocurrió un error al actualizar el estudio " & strDeterminacion & " cargado para el protocolo Nº" & lngIdProtocolo & " en el sistema.", vbCrLf & vbCrLf)
If (mIntProceso <> 2) Then
mIntProceso = 3
Else
mIntProceso = 5
End If
End If
End With
Else
mStrDetalle = stragr(mStrDetalle, "No se encontro el estudio " & strDeterminacion & IIf(strMetodo = "", "", " " & strMetodo) & " cargado para el protocolo Nº" & lngIdProtocolo & " en el sistema.", vbCrLf & vbCrLf)
If (mIntProceso <> 2) And (mIntProceso <> 3) And (mIntProceso <> 5) Then
mIntProceso = 4
End If