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 Sub
'''