Transformación de unidades en MS Access

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

Leave a Reply

Your email address will not be published. Required fields are marked *