He escrito código nuevo para intentar transformar un campo “string” en uno “long” y tratar las unidades, es decir, por ejemplo si tenemos un campo con “1000 kg” que se transforme simplemente en 1 y la unidad es la misma para todos los registros (toneladas). Hay una función que la he cogido de una web donde ofrecen pequeñas funciones para el tratamiento de strings. A continuación todo el código:
Option Compare Database ' ExecuteQuery: Realitza una modificació a la BD ' Provar amb: ' ExecuteQuery "INSERT INTO CamaraEnvasadoPreenvasado VALUES ('test', 'borrar')" Sub ExecuteQuery(strSQL As String) Dim cnn As ADODB.Connection Dim lngAffected As Long ' Open the connection. Set cnn = CurrentProject.Connection ' Execute the query. cnn.Execute CommandText:=strSQL, _ RecordsAffected:=lngAffected, _ Options:=adExecuteNoRecords 'Debug.Print "Records Affected = " & lngAffected ' Close connection and destroy object variables. cnn.Close Set cnn = Nothing End Sub ' TransformDB: Convierte los campos "volumen", "produccion_por_dia" ' y "Camara_frigorifica" de string a integer, realizando las ' conversiones necesarias y descartando valores incorrectos ' ** Tabla FrutasHortalizas ** ' "volumen" -> toneladas ' "produccion_por_dia" -> toneladas/dia ' "Camara_frigorifica" -> m3 ' "Num_Asocidos" -> quitamos coletilla "socios" y dejamos Sub ConvertDB() Dim cnnDB As ADODB.Connection Dim recordSt As New ADODB.Recordset Dim strSQL As String Dim idSuscriptor As String Dim i As Integer Dim volumen As String Dim produccion As String Dim camara As String Dim NumAsociados As String Dim volumenFinal As Long Dim produccionFinal As Long Dim camaraFinal As Long Dim NumAsociadosFinal As Long ' Connectar a la BD actual: Set cnnDB = CurrentProject.Connection ' Obtenim tots els registres que tenen alguna ' dada a algun dels camps que tractem 'strSQL = "SELECT * FROM Frustas_Hortalizas WHERE NOT (volumen = '') OR NOT (produccion_por_dia = '') OR NOT (camara_frigorifica = '') " strSQL = "SELECT * FROM Frustas_Hortalizas" With recordSt Set .ActiveConnection = cnnDB .CursorType = adOpenKeyset .CursorLocation = adUseClient .LockType = adLockOptimistic .Open strSQL End With ' Tractar els camps i actualitzar taula i = 0 If Not recordSt.EOF Then recordSt.MoveFirst End If Do While Not recordSt.EOF idSuscriptor = recordSt.Fields("Numero de suscriptor").Value If Not IsNull(recordSt.Fields("Volumen").Value) Then volumen = recordSt.Fields("Volumen").Value volumenFinal = convertirUnidades(GetFirstWord(volumen), GetLastWord(volumen)) 'Debug.Print "volumen " & volumenFinal Else volumenFinal = 0 'Debug.Print "zero " & volumenFinal End If If Not IsNull(recordSt.Fields("Produccion_por_dia").Value) Then produccion = recordSt.Fields("Produccion_por_dia").Value produccionFinal = convertirUnidades(GetFirstWord(produccion), GetLastWord(produccion)) Else produccionFinal = 0 End If If Not IsNull(recordSt.Fields("Camara_frigorifica").Value) Then camara = recordSt.Fields("Camara_frigorifica").Value If (GetLastWord(camara) = "m3") Then camaraFinal = CLng(GetFirstWord(camara)) Else camaraFinal = 0 End If Else camaraFinal = 0 End If If Not IsNull(recordSt.Fields("Num_asociados").Value) Then NumAsociados = recordSt.Fields("Num_asociados").Value If (GetLastWord(NumAsociados) <> GetFirstWord(NumAsociados)) Then NumAsociadosFinal = CLng(GetFirstWord(NumAsociados)) Else NumAsociadosFinal = CLng(NumAsociados) End If Else NumAsociadosFinal = 0 End If 'If Not IsNull(recordSt.Fields("N_trabajadores").Value) Then 'NTrabajadores = recordSt.Fields("N_trabajadores").Value 'If (GetLastWord(NTrabajadores) <> GetFirstWord(NTrabajadores)) Then 'NTrabajadores = CLng(GetFirstWord(NTrabajadores)) 'End If 'Else 'NTrabajadores = 0 'End If 'Debug.Print "UPDATE Frustas_Hortalizas SET volumen = '" & volumenFinal & "', Produccion_por_dia = '" & produccionFinal & "', Camara_frigorifica = '" & camaraFinal & "' WHERE ""Numero de suscriptor"" = " & idSuscriptor & "" Debug.Print "UPDATE Frustas_Hortalizas SET volumen = '" & volumenFinal & "', Produccion_por_dia = '" & produccionFinal & "', Camara_frigorifica = '" & camaraFinal & "', Num_asociados = '" & NumAsociadosFinal & "' WHERE [Numero de suscriptor] = " & idSuscriptor & "" ExecuteQuery "UPDATE Frustas_Hortalizas SET volumen = '" & volumenFinal & "', Produccion_por_dia = '" & produccionFinal & "', Camara_frigorifica = '" & camaraFinal & "', Num_asociados = '" & NumAsociadosFinal & "' WHERE [Numero de suscriptor] = " & idSuscriptor & "" 'Exit Do i = i + 1 recordSt.MoveNext Loop 'Debug.Print "Fields " & recordSt.Fields.Count Debug.Print "Found " & i & " registers" ' Close Connection object and destroy object variable. cnnDB.Close Set cnnDB = Nothing End Sub ' TransformDB: Convierte los campos "Anyo_creacion", "N_trabajadores" ' "Ventas_anuales" a numeros sin texto (tabla Empresa) Sub ConvertDB2() Dim cnnDB As ADODB.Connection Dim recordSt As New ADODB.Recordset Dim strSQL As String Dim idSuscriptor As String Dim i As Integer Dim anyoCreacion As String Dim NTrabajadores As String Dim VentasAnuales As String Dim anyoCreacionFinal As Long Dim NTrabajadoresFinal As Long Dim VentasAnualesFinal As Long ' Connectar a la BD actual: Set cnnDB = CurrentProject.Connection ' Obtenim tots els registres que tenen alguna ' dada a algun dels camps que tractem 'strSQL = "SELECT * FROM Frustas_Hortalizas WHERE NOT (volumen = '') OR NOT (produccion_por_dia = '') OR NOT (camara_frigorifica = '') " strSQL = "SELECT * FROM Empresa" With recordSt Set .ActiveConnection = cnnDB .CursorType = adOpenKeyset .CursorLocation = adUseClient .LockType = adLockOptimistic .Open strSQL End With ' Tractar els camps i actualitzar taula i = 0 If Not recordSt.EOF Then recordSt.MoveFirst End If Do While Not recordSt.EOF idSuscriptor = recordSt.Fields("Numero de subscriptor").Value If Not IsNull(recordSt.Fields("Anyo_creacion").Value) Then anyoCreacion = recordSt.Fields("Anyo_creacion").Value If (GetLastWord(anyoCreacion) <> GetFirstWord(anyoCreacion)) Then anyoCreacionFinal = CLng(GetFirstWord(anyoCreacion)) Else anyoCreacionFinal = CLng(anyoCreacion) End If Else anyoCreacionFinal = 0 End If If Not IsNull(recordSt.Fields("N_trabajadores").Value) Then NTrabajadores = recordSt.Fields("N_trabajadores").Value If (GetLastWord(NTrabajadores) <> GetFirstWord(NTrabajadores)) Then NTrabajadoresFinal = CLng(GetFirstWord(NTrabajadores)) Else NTrabajadoresFinal = CLng(NTrabajadores) End If Else NTrabajadoresFinal = 0 End If If Not IsNull(recordSt.Fields("Ventas_anuales_estimadas_Euros").Value) Then VentasAnuales = recordSt.Fields("Ventas_anuales_estimadas_Euros").Value If (GetLastWord(VentasAnuales) <> GetFirstWord(VentasAnuales)) Then VentasAnualesFinal = CLng(GetFirstWord(VentasAnuales)) Else VentasAnualesFinal = CLng(VentasAnuales) End If Else VentasAnualesFinal = 0 End If Debug.Print "UPDATE Empresa SET Ventas_anuales_estimadas_Euros = '" & VentasAnualesFinal & "', N_trabajadores = '" & NTrabajadoresFinal & "', anyo_creacion = '" & anyoCreacionFinal & "' WHERE [Numero de subscriptor] = " & idSuscriptor & "" ExecuteQuery "UPDATE Empresa SET Ventas_anuales_estimadas_Euros = '" & VentasAnualesFinal & "', N_trabajadores = '" & NTrabajadoresFinal & "', anyo_creacion = '" & anyoCreacionFinal & "' WHERE [Numero de subscriptor] = " & idSuscriptor & "" 'Exit Do i = i + 1 recordSt.MoveNext Loop 'Debug.Print "Fields " & recordSt.Fields.Count Debug.Print "Found " & i & " registers" ' Close Connection object and destroy object variable. cnnDB.Close Set cnnDB = Nothing End Sub Function convertirUnidades(left As String, right As String) As Long Dim final As Long If (left = right) Then final = 0 Else If (LCase(right) = "tn") Or (LCase(right) = "t") Or (LCase(right) = "tn/dia") Or (LCase(right) = "tn/día") Or (LCase(right) = "palets/dia") Or (LCase(right) = "palets/día") Then final = CLng(left) Else If (LCase(right) = "kg") Or (LCase(right) = "kg/dia") Or (LCase(right) = "kg/día") Then final = CLng(CLng(left) / 1000) Else final = 0 End If End If End If 'MsgBox final convertirUnidades = final End Function 'http://www.peterssoftware.com/strfn.htm Function GetLastWord(sStr As String) As String '* Returns the last word in sStr Dim i As Integer Dim ilen As Integer Dim s As String Dim stemp As String Dim sLastWord As String Dim sHold As String Dim iFoundChar As Integer stemp = "" sLastWord = "" iFoundChar = False sHold = sStr ilen = Len(sStr) For i = ilen To 1 Step -1 s = right(sHold, 1) If s = " " Then If Not iFoundChar Then '* skip spaces at end of string. Else sLastWord = stemp Exit For End If Else iFoundChar = True stemp = s & stemp End If If Len(sHold) > 0 Then sHold = left(sHold, Len(sHold) - 1) End If Next i If sLastWord = "" And stemp <> "" Then sLastWord = stemp End If 'MsgBox "lastword =" & Trim(sLastWord) GetLastWord = Trim(sLastWord) End Function 'http://www.peterssoftware.com/strfn.htm Function GetFirstWord(sStr As String) As String '* Returns the last word in sStr Dim i As Integer Dim ilen As Integer Dim s As String Dim stemp As String Dim sLastWord As String Dim sHold As String Dim iFoundChar As Integer stemp = "" sLastWord = "" iFoundChar = False sHold = sStr ilen = Len(sStr) For i = 1 To ilen Step 1 s = left(sHold, 1) If s = " " Then If Not iFoundChar Then '* skip spaces at end of string. Else sLastWord = stemp Exit For End If Else iFoundChar = True stemp = stemp & s End If If Len(sHold) > 0 Then sHold = right(sHold, Len(sHold) - 1) End If Next i If sLastWord = "" And stemp <> "" Then sLastWord = stemp End If 'MsgBox "lastword =" & Trim(sLastWord) GetFirstWord = Trim(sLastWord) End Function