0

Estoy trabajando en un proyecto de administración de ventas en VBA for Applications (Excel) y MariaDB (Me apoyo con ChatGPT). Se requiere un formualrio para la emisión de un documento llamado "Remito", con las mismas características de una factura, al presionar un botón. Los datos se encuentran en TextBox y un Listview. El código del botón consta de 5 procedimientos: GenerateRem (envía los datos al formato del remito en una hoja de Excel), SendDataBaseRemito (envía los datos a la base de datos MariaDB), MarkPageBreaksRemito (selecciona el área de impresión), PrintRemito (imprime el remito, ClearRemito (limpia el formato en la hoja de Excel y el formulario de emisión). El problema lo tengo en el procedimiento SendDataBaseRemito. Se genera el error ‘-2147467259(80004005)’ en tiempo de ejecución: Tipo de parámetro no compatible. He revisado detalladamente la estructura de la bases de datos, y el código VBA, pero no consigo identificar dónde se origina el error. ''' Sub SendDataBaseRemito() ' Manejo de errores On Error GoTo ErrorHandler

' Obtener fecha de la interfaz y formatear
Dim updateDate As String
Dim UpdateYear As Integer
Dim UpdateMonth As Integer
Dim UpdateDay As Integer

UpdateYear = VBA.Year(Me.TxtDateRemito.value)
UpdateMonth = VBA.Month(Me.TxtDateRemito.value)
UpdateDay = VBA.Day(Me.TxtDateRemito.value)
updateDate = Application.WorksheetFunction.Concat(UpdateYear, "-", UpdateMonth, "-", UpdateDay)

Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")

' Definir la consulta parametrizada
Dim queryText As String
queryText = "INSERT INTO vtaremito (codigodoc, fecha, ccliente, nombrecliente, dnicliente, cuitcliente, emailcliente, direccioncliente, direccionenvio, telefonocliente, condicionvta, cproductos, cantidad, productos, precio, descuento, monto, subtotal, porciva, montoiva, total1, flete, anticipo, total2, idusuario, cusuario, usuario, nombre) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"

Dim listViewItem As ListItem
Dim i As Integer
Dim j As Integer
Dim subItemValue As String
Dim numItems As Integer
Dim numColumns As Integer

' Obtener el número de ítems en el ListView
numItems = Me.ListView1.ListItems.Count
' Obtener el número de columnas en el ListView
numColumns = Me.ListView1.ColumnHeaders.Count

For i = 1 To numItems
    ' Crear un objeto Command para la consulta parametrizada
    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")
    cmd.ActiveConnection = dBase

    ' Definir la consulta parametrizada
    cmd.CommandText = queryText

    Set listViewItem = Me.ListView1.ListItems(i)

    ' Verificar si la consulta devuelve resultados
    cmd.Parameters.Append cmd.CreateParameter("codigodoc", adChar, adParamInput, 9, Me.TxtNroRemito.value)
    cmd.Parameters.Append cmd.CreateParameter("codigodoc", adChar, adParamInput, 9, Me.TxtNroRemito.value)
    cmd.Parameters.Append cmd.CreateParameter("fecha", adDate, adParamInput, , updateDate)

    Dim CodCliente As String

    CodCliente = Me.TxtCodCustomerRem.value

    ' Convertir el valor a long (convertir a número)
    Dim CodClienteValue As Long

    CodClienteValue = SafeCLng(CodCliente)
    cmd.Parameters.Append cmd.CreateParameter("ccliente", adInteger, adParamInput, , CodClienteValue)
    cmd.Parameters.Append cmd.CreateParameter("nombrecliente", adVarChar, adParamInput, 100, Me.TxtNameCustomerRem.value)

    Dim DniCliente As String

    DniCliente = Me.TextDniCustomerRem.value

    Dim DniClienteValue As Long

    DniClienteValue = SafeCLng(DniCliente)
    cmd.Parameters.Append cmd.CreateParameter("dnicliente", adInteger, adParamInput, , DniClienteValue)
    cmd.Parameters.Append cmd.CreateParameter("cuitcliente", adChar, adParamInput, 30, Me.TextCuitCustomerRem.value)
    cmd.Parameters.Append cmd.CreateParameter("emailcliente", adVarChar, adParamInput, 100, Me.TextEmailCustomerRem.value)
    cmd.Parameters.Append cmd.CreateParameter("direccioncliente", adVarChar, adParamInput, 200, StrConv(Me.TextAddressCustomerRem.value, vbUnicode))
    cmd.Parameters.Append cmd.CreateParameter("direccionenvío", adVarChar, adParamInput, 200, StrConv(Me.TextMailingAddressRem.value, vbUnicode))
    
    Dim Telefono As String

    Telefono = Me.TextTelCustomerRem.value

    Dim TelefonoValue As Long

    TelefonoValue = SafeCLng(Telefono)
    cmd.Parameters.Append cmd.CreateParameter("telefonocliente", adInteger, adParamInput, , TelefonoValue)
    cmd.Parameters.Append cmd.CreateParameter("condicionvta", adVarChar, adParamInput, 30, Me.CboxSaleCondRem.value)

    ' Iterar por cada subitem en el ítem actual
    For j = 1 To numColumns
        ' Obtener el valor del subitem
        If j = 1 Then
            subItemValue = listViewItem.Text
        Else
            subItemValue = listViewItem.SubItems(j - 1)
        End If

        If j = 1 Then
            cmd.Parameters.Append cmd.CreateParameter("cproductos", adVarChar, adParamInput, 30, subItemValue)
        End If

        If j = 2 Then
            Dim Cantidad As String

            Cantidad = subItemValue

            Dim CantidadValue As Long

            CantidadValue = SafeCLng(Cantidad)
            cmd.Parameters.Append cmd.CreateParameter("cantidad", adInteger, adParamInput, , CantidadValue)
        End If

        If j = 3 Then
            cmd.Parameters.Append cmd.CreateParameter("productos", adVarChar, adParamInput, 255, subItemValue)
        End If

        If j = 4 Then
            Dim Precio As String

            Precio = subItemValue

            Dim PrecioValue As Double

            PrecioValue = SafeCDbl(Precio)
            cmd.Parameters.Append cmd.CreateParameter("precio", adInteger, adParamInput, , PrecioValue)
        End If

        If j = 5 Then
            Dim Descuento As String

            Descuento = subItemValue

            Dim DescuentoValue As Double

            DescuentoValue = SafeCDbl(Descuento)
            
            cmd.Parameters.Append cmd.CreateParameter("descuento", adInteger, adParamInput, , DescuentoValue)
        End If

        If j = 6 Then
            Dim Monto As String

            Monto = subItemValue

            Dim MontoValue As Double

            MontoValue = SafeCDbl(Monto)
            cmd.Parameters.Append cmd.CreateParameter("monto", adInteger, adParamInput, , MontoValue)
        End If
        
        If j = numColumns Then Exit For
    Next j

    Dim SubTotal As String

    SubTotal = Me.TextSubTotaltRem.value

    Dim SubTotalValue As Double

    SubTotalValue = SafeCDbl(SubTotal)
    Call AppendNumericParameter_10_2(cmd, "subtotal", SubTotalValue)

    Dim PorcIva As String

    PorcIva = Me.TextPorcVatRem.value

    Dim PorcIvaValue As Double

    PorcIvaValue = SafeCDbl(PorcIva)
    Call AppendNumericParameter_4_2(cmd, "porciva", PorcIvaValue)

    Dim MontoIva As String

    MontoIva = Me.TextVatRem.value

    Dim MontoIvaValue As Double

    MontoIvaValue = SafeCDbl(MontoIva)
    Call AppendNumericParameter_10_2(cmd, "montoiva", MontoIvaValue)

    Dim Total1 As String

    Total1 = Me.TextTotal1Rem.value

    Dim Total1Value As Double

    Total1Value = SafeCDbl(Total1)
    Call AppendNumericParameter_10_2(cmd, "total1", Total1Value)

    Dim Flete As String

    Flete = Me.TextFreightRem.value

    Dim FleteValue As Double

    FleteValue = SafeCDbl(Flete)
    Call AppendNumericParameter_10_2(cmd, "flete", FleteValue)

    Dim Anticipo As String

    Anticipo = Me.TextAdvanceRem.value

    Dim AnticipoValue As Double

    AnticipoValue = SafeCDbl(Anticipo)
    Call AppendNumericParameter_10_2(cmd, "anticipo", AnticipoValue)

    Dim Total2 As String

    Total2 = Me.TextTotal2Rem.value

    Dim Total2Value As Double

    Total2Value = SafeCDbl(Total2)
    Call AppendNumericParameter_10_2(cmd, "total2", Total2Value)

    Dim IdUsuario As String

    IdUsuario = Form_0000_000_MP.LbCurrentIdUserName.Caption

    Dim IdUsuarioValue As Double

    IdUsuarioValue = SafeCLng(IdUsuario)
    cmd.Parameters.Append cmd.CreateParameter("idusuario", adInteger, adParamInput, , IdUsuarioValue)
    cmd.Parameters.Append cmd.CreateParameter("cusuario", adChar, adParamInput, 16, Form_0000_000_MP.LbCurrentCUserName.Caption)
    cmd.Parameters.Append cmd.CreateParameter("usuario", adChar, adParamInput, 20, Form_0000_000_MP.LbCurrentUserName.Caption)
    cmd.Parameters.Append cmd.CreateParameter("nombre", adVarChar, adParamInput, 50, Form_0000_000_MP.LbCurrentName.Caption)

    ' Imprimir valores para depuración
    Debug.Print Me.TxtNroRemito.value
    Debug.Print updateDate
    Debug.Print CodClienteValue
    Debug.Print Me.TxtNameCustomerRem.value
    Debug.Print DniClienteValue
    Debug.Print Me.TextCuitCustomerRem.value
    Debug.Print Me.TextEmailCustomerRem.value
    Debug.Print Me.TextAddressCustomerRem.value
    Debug.Print Me.TextMailingAddressRem.value
    Debug.Print TelefonoValue
    Debug.Print Me.CboxSaleCondRem.value
    Debug.Print listViewItem.Text
    Debug.Print CantidadValue
    Debug.Print listViewItem.ListSubItems(2).Text
    Debug.Print PrecioValue
    Debug.Print DescuentoValue
    Debug.Print MontoValue
    Debug.Print SubTotalValue
    Debug.Print PorcIvaValue
    Debug.Print MontoIvaValue
    Debug.Print Total1Value
    Debug.Print FleteValue
    Debug.Print AnticipoValue
    Debug.Print Total2Value
    Debug.Print IdUsuarioValue
    Debug.Print Form_0000_000_MP.LbCurrentCUserName.Caption
    Debug.Print Form_0000_000_MP.LbCurrentUserName.Caption
    Debug.Print Form_0000_000_MP.LbCurrentName.Caption
    
    cmd.Execute
    
    ' Verificar que el ítem actual exista
    If i = numItems Then Exit For
Next i

' Limpiar y liberar objetos
Set cmd = Nothing

ErrorHandler: ' Mostrar un mensaje con detalles del error MsgBox "Error número: " & Err.Number & vbCrLf & _ "Descripción: " & Err.Description & vbCrLf & _ "Ocurrió en el ítem número: " & i & vbCrLf & _ "Ocurrió en el subitem número: " & j, vbCritical, "Error en la inserción de datos"

CleanUp: ' Llamar a MarkPageBreaksRemito en caso de error On Error Resume Next If Not rs Is Nothing Then If rs.State = 1 Then rs.Close Set rs = Nothing End If On Error GoTo 0 End SubTabla vtaremito en MariaDB

'''

7
  • Mira Cómo preguntar para que tu pregunta sea mejor recibida. También, aprovecha y haz el recorrido de bienvenida para entender mejor cómo funcionamos y de paso obtener tu primera medalla! Cual es la linea exacta donde te da el error?? eso lo podes saber siguiendo tu codigo linea por linea, o sacando el on error, porque si no sabes que hacer con eso, no sirve para nada...
    – gbianchi
    Commented el 21 oct. a las 13:21
  • Gracias por tu recomendación. Error se genera en el ciclo for correspondiente al Listview, identificado con por el comentario: Iterar por cada subitem en el ítem actual. Commented el 21 oct. a las 13:32
  • En cual de todas las lineas? ese for j no tiene nada de sentido.. si lo llenas de if, entonces se puede reemplazar por funciones. En realidad la mayor parte de tu codigo se podria simplificar un monton... generar la consulta en todas las vueltas tampoco tiene sentido.. pero sigamos con tu error, que linea genera el error?
    – gbianchi
    Commented el 21 oct. a las 14:27
  • No especifica la línea. Al finalizar el ciclo, el on error envía el siguiente mensaje: ocurrió en el ítem número: 1, ocurrió en el subítem número: 6. Si elimino el on error, el mensaje de error dice: No data supplied for parameters in prepared statement. Entiendo tu planteamiento respecto a los if, trataré de simplificarlo. Commented el 21 oct. a las 16:06
  • No data supplied for parameters in prepared statement este es tu error real! ahora bien, cual linea lo produce??? sabes hacer un seguimiento? porque eso es lo que tenes que hacer ahora, para ver cual linea exactamente tiene el problema....
    – gbianchi
    Commented el 21 oct. a las 16:10

0

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

Examina otras preguntas con la etiqueta o formula tu propia pregunta.