Dos scripts que permiten modificar números de cuentas contables

Los dos script que se presenta a continuación son un buen punto de partida para hacer cambios masivos en la numeración de los dígitos de las cuentas contables.

Creación de todas las cuentas de cliente con 8 dógitos seguidos del código de cliente

Sub Main (PS0, PS1, PS2)

Cn.Execute "delete cuenta where nivel=3 and numero like '430%'"
Dim Cliente : Set Cliente = CreateObject ("ADODB.Recordset") : Cliente.CursorLocation = 3 'AdUseClient
Cliente.Open "SELECT Cliente FROM Factura GROUP BY Cliente ORDER BY Cliente", Cn : Set Cliente.ActiveConnection = Nothing
Do While Not Cliente.EOF
CuentaCorrecta = "430" & Right ("00000" & Cliente.Fields ("Cliente"), 5)
BaseDeDatos.Introduce "Cuenta", "Numero, Subcuenta, Anterior, Nivel, Descripcion", FH.SQLT (CuentaCorrecta) & ", 1, '430',3," & FH.SQLT (BaseDeDatos.Cmp ("Cliente", "Nombre", "Codigo=" & Cliente.Fields ("Cliente"), False))
Cliente.MoveNext
Loop

End Sub

Modificación de todos los apuntes correspondientes a facturas y cobros para adaptarlo a cuentas de cliente de 8 dígitos

El proceso consiste en:

Recorrer todos los apuntes.
Para cada apunte, localizar el hecho contable, en este caso documento, correspondiente (factura o cobro).
Localizar el código de cliente correspondiente a este hecho contable.
Construir el nº de cuenta adecuada.
Modificar el apunte para que utilice ese numero de cuenta.

Sub Main (PS0, PS1, PS2)

Dim Apunte : Set Apunte = CreateObject ("ADODB.Recordset") : Apunte.CursorLocation = 3 'AdUseClient
Apunte.Open "SELECT Numero, Asiento, Cuenta FROM Apunte WHERE Cuenta LIKE '430%' And Len (Cuenta) = 7 ORDER BY Numero", Cn : Set Apunte.ActiveConnection = Nothing
Do While Not Apunte.EOF
TipoDocumento = BaseDeDatos.Cmp ("Asiento", "TipoDocumento", "Numero=" & Apunte.Fields ("Asiento"), False)
PrefijoDocumento = BaseDeDatos.Cmp ("Asiento", "PrefijoDocumento", "Numero=" & Apunte.Fields ("Asiento"), False)
NumeroDocumento = BaseDeDatos.Cmp ("Asiento", "NumeroDocumento", "Numero=" & Apunte.Fields ("Asiento"), False)
Cliente = ""
If LCase (TipoDocumento) = "factura"

Cliente = BaseDeDatos.Cmp ("Factura", "Cliente", "Prefijo=" & FH.SQLT (PrefijoDocumento) & " And Numero=" & NumeroDocumento, False)
End If
If LCase (TipoDocumento) = "cobro" or LCase (TipoDocumento) = "devolucion" Then
Cliente = BaseDeDatos.Cmp ("Recibo", "Cliente", "Prefijo=" & FH.SQLT (PrefijoDocumento) & " And Numero=" & NumeroDocumento, False)

End If
If Cliente <> "" Then
CuentaCorrecta = "430" & Right ("00000" & Cliente, 5)
BaseDeDatos.Modifica "Apunte", "Cuenta=" & FH.SQLT (CuentaCorrecta), "Numero=" & Apunte.Fields ("Numero")
End If
Apunte.MoveNext
Loop

End Sub

Modificación directa de cuentas

El proceso consiste en:

Recorrer todas las subcuentas.
Para cada una de ellas, si la la longitud es de 7 dígitos, crea un nuevo codigo a partir de los tres primeros y los cuatro últimos separados por un nuevo caracter "0".
Modificar todos los registros de la tabla "Cuenta" y "Apunte" con el nuevo número.

Sub Main (PS0, PS1, PS2)

Dim Cuenta : Set Cuenta = CreateObject ("ADODB.Recordset") : Cuenta.CursorLocation = 3 'AdUseClient
Cuenta.Open "SELECT Numero FROM Cuenta WHERE Subcuenta=1 ORDER BY Numero", Cn : Set Cuenta.ActiveConnection = Nothing
Do While Not Cuenta.EOF

If Len (Cuenta.Fields ("Numero")) = 7 Then

CuentaCorrecta = Left (Cuenta.Fields ("Numero"), 3) & "0" & Right (Cuenta.Fields ("Numero"), 4)
BaseDeDatos.Modifica "Cuenta", "Numero=" & FH.SQLT (CuentaCorrecta), "Numero=" & FH.SQLT (Cuenta.Fields ("Numero"))
BaseDeDatos.Modifica "Apunte", "Cuenta=" & FH.SQLT (CuentaCorrecta), "Cuenta=" & FH.SQLT (Cuenta.Fields ("Numero"))

End If
Cuenta.MoveNext

Loop

End Sub

Volver a la búsqueda anterior