Título: ERROR 457 esta clave ya esta asociada a un elemento de esta colección Publicado por: GzaRC en 4 Septiembre 2019, 21:33 pm 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 |