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