Código:
Esta es mi función en un módulo para llamarla desde el formulario del usuarioCREATE PROCEDURE `GrabarDoc`(opt int,
TipoDoc int,
FechaDoc date,
Cliente int,
Redactor int,
Asunto varchar(2000),
TipoSal int)
BEGIN
DECLARE Corre int;
DECLARE CorreOp int;
DECLARE Fijo varchar(20);
DECLARE CorCaso varchar(100);
DECLARE Serie VARCHAR(5);
case opt
WHEN 1 THEN
-- selecciono el último número y le sumo 1 para guardarlo en una variable
SET Corre=((SELECT IdDoc
FROM documento ORDER BY IdDoc DESC limit 0,1 )+1);
-- para que no marque error
if corre is null then
set corre=1;
end if;
-- Le doy formato al numero para que no sea 9 sino 00009
if LENGTH(corre)= 1 THEN
set Serie=concat("000",corre);
elseif LENGTH(corre)= 2 then
set Serie=concat("00",corre);
elseif LENGTH(corre)= 3 then
set Serie=concat("0",corre);
elseif LENGTH(corre)= 4 then
set Serie=corre;
end if;
--sigo formateando el numero de tal manera que sea una mezcla del año y correlativo, así: 120009 ; 12 por el año 2012 y el 0009 por el número formateado anteriormente.
SET Fijo=(SELECT Numero FROM configuracion
WHERE Año=year(now()));
SET CorCaso=concat(Fijo,serie);
--ingreso los datos en la tabla documentos
INSERT INTO documento(IdDoc,IdDocumento,TipoDoc,
Fecha,IdCliente,IdRedactor,Asunto,IdTipoSal)
VALUES (Corre,CorCaso,TipoDoc,
FechaDoc,Cliente,Redactor,Asunto,TipoSal);
--selecciono el último número ingresado para mostrarlo en el formulario
SELECT IdDocumento from documento
WHERE IdDoc=corre AND IdDocumento=CorCaso;
END CASE;
END
Código:
Finalmente mi código de formulario:Public Function GrabarDocumento(iOpt As Integer, iTipoDoc As Integer, _
dFechaDoc As Date, iCliente As Integer, _
iRedactor As Integer, sAsunto As String, _
iTipoSal As Integer) As Recordset
Dim Rs As New ADODB.Recordset
CMD.ActiveConnection = Cn
Set Rs = New ADODB.Recordset
CMD.CommandType = adCmdStoredProc
CMD.CommandTimeout = 30
CMD.CommandText = "GrabarDoc"
With CMD
.Parameters.Append .CreateParameter("opt", adInteger, adParamInput, , iOpt)
.Parameters.Append .CreateParameter("TipoDoc", adInteger, adParamInput, , iTipoDoc)
.Parameters.Append .CreateParameter("FechaDoc", adDate, adParamInput, , dFechaDoc)
.Parameters.Append .CreateParameter("Cliente", adInteger, adParamInput, , iCliente)
.Parameters.Append .CreateParameter("Redactor", adInteger, adParamInput, , iRedactor)
.Parameters.Append .CreateParameter("Asunto", adVarChar, adParamInput, 2000, sAsunto)
.Parameters.Append .CreateParameter("TipoSal", adInteger, adParamInput, , iTipoSal)
Rs.Open .Execute
End With
Set GrabarDocumento = Rs
Set CMD = Nothing
End Function
Código:
Agradezco a todos su atención y espero que me puedan ayudar no se si soy yo que he programado mal o es el Mysql que no está trabajando bien en multiusuario. Private Sub cmdACEPTAR_Click()
Dim CAD As String
Dim RTE As String
Dim SQL As String
Dim SQL2 As String
Dim RsRem As New ADODB.Recordset
Dim RsDoc As New ADODB.Recordset
Dim RsGra As New ADODB.Recordset
Dim RsNum As New ADODB.Recordset
On Error GoTo ErrorSub
If SW = 1 Then
'CONECTO CON LA BASE DE DATOS
If Cn.State = 1 Then Cn.Close
Call Conectar(User, Pass)
'BUSCO EL CODIGO DEL TIPO DE DOCUMENTO
CAD = "SELECT IdTipoDoc FROM tipodoc WHERE TipoDoc='" & cmbTIPODOC & "'"
RsDoc.Open CAD, Cn, adOpenKeyset, adLockOptimistic
iTipoDoc = RsDoc.Fields(0)
'BUSCO EL CODIGO DEL REDACTOR DEL DOCUMENTO
RTE = "SELECT IdRedactor FROM Redactores WHERE Redactor='" & cmbREDACTOR & "'"
RsRem.Open RTE, Cn, adOpenKeyset, adLockOptimistic
iRedac = RsRem.Fields(0)
'COMO EL PROCEDIMIENTO ALMACENADO AL EJECUTARLO ME ARROJA EL NÚMERO CORRELATIVO CAPTURO ESTE EN UNA ETIQUETA LLAMADA lblNUMDOC
Me.lblNUMDOC = GrabarDocumento(SW, iTipoDoc, dtpFECHA.Value, Me.txtIDCLIENTE.Text, iRedac, Me.txtASUNTO.Text, iSalida).Fields(0)
MsgBox "Registro Ingresado", vbInformation, "DocuSis"
'LIMPIO LAS VARIABLES
CAD = ""
iTipoDoc = 0
RTE = ""
iRedac = 0
SQL = ""
SQL2 = ""
iCore = 0
Set RsGra = Nothing
End If
Exit Sub
'GUARDO LOS ERRORES EN EL LOG
ErrorSub:
Call ErrorGral("frmCLIENTE2", "Private sub cmdGRABAR_Click()")
end sub


Este tema le ha gustado a 1 personas