ADO Command / Parameter in Excel (VBA)

2

Hello,

I'm developing a code in VBA in Excel 2010 in conjunction with an Access 2010 bank.

In this code, I use ADO Command to manipulate the data in the database, however I am getting an error message in a particular piece of code.

The following is the code below:

Private Sub SalvarTermo()
On Error GoTo TrataErro

    Dim cnn As ADODB.Connection
    Dim cmd As New ADODB.Command
    Dim cmdAux As New ADODB.Command
    Dim rst As ADODB.Recordset
    Dim Termo As String
    Dim Abreviacao As String
    Dim Verificar As String
    Dim Grupo As String
    Dim id_Termo As Variant
    Dim Acao As String
    Dim DataHoraAtual As String
    Dim Fim As Boolean

    Fim = False

    If trim(UCase(txtTermo.Value)) = "" Then
        MsgBox msgFaltaTermo, vbOKOnly + vbExclamation, "Editar termos"
        Fim = True
        GoTo Fim
    Else
        Termo = trim(UCase(txtTermo.Value))
    End If

    Set cnn = ConectaBanco
    Set cmd.ActiveConnection = cnn
    Set cmdAux.ActiveConnection = cnn
    cmd.CommandType = adCmdText
    cmdAux.CommandType = adCmdText

    If trim(UCase(cboxGrupo.Value)) = "" Then
        MsgBox msgFaltaGrupo, vbOKOnly + vbExclamation, "Editar termos"
        Fim = True
        GoTo Fim
    Else
        cmdAux.CommandText = "SELECT tblGrupos.id FROM tblGrupos WHERE tblGrupos.Descricao = @Grupo"
        cmdAux.Parameters.Append cmdAux.CreateParameter("@Grupo", adVarChar, adParamInput, 500, trim(UCase(cboxGrupo.Value)))
        Set rst = cmdAux.Execute

        If Not cmdAux Is Nothing Then
            Set cmdAux = Nothing
        End If

        Grupo = rst.Fields("id").Value
    End If

    If trim(UCase(cboxVerificar.Value)) = "" Then
        MsgBox msgFaltaVerificar, vbOKOnly + vbExclamation, "Editar termos"
        Fim = True
        GoTo Fim
    Else
        Verificar = TrataVerificar(cboxVerificar.Value)
    End If

    If chkboxSemAbreviacao.Value = True Then
        Abreviacao = ""
    Else
        Abreviacao = trim(UCase(txtAbreviacao.Value))
    End If

    cmd.CommandText = "SELECT tblTermos.Termo FROM tblTermos WHERE Termo = @Termo and Excluido = False"
    cmd.Parameters.Append cmd.CreateParameter("@Termo", adVarChar, adParamInput, 500, Termo)
    Set rst = cmd.Execute

    If rst.EOF Then
        If MsgBox("Deseja realmente cadastrar o termo """ & Termo & """ com as informações abaixo?" & vbNewLine & _
        "- Abreviação: " & TrataAbreviacao(Abreviacao) & vbNewLine & _
        "- Grupo: """ & trim(cboxGrupo.Value) & """" & vbNewLine & _
        "- Verificar: """ & cboxVerificar.Value & """", vbYesNo + vbQuestion, "Cadastrar termo") = vbYes Then
            cmd.CommandText = "SELECT tblTermos.Termo FROM tblTermos WHERE tblTermos.Termo = @Termo and Excluido = True"
            cmd.Parameters.Append cmd.CreateParameter("@Termo", adVarChar, adParamInput, 500, Termo)
            Set rst = cmd.Execute

            If rst.EOF Then
                cmd.CommandText = "INSERT INTO tblTermos (id_Grupo, Termo, Verificar, Excluido) Values (@Grupo, @Termo, @Verificar, False)"
                cmd.Parameters.Append cmd.CreateParameter("@Grupo", adVarChar, adParamInput, 500, Grupo)
                cmd.Parameters.Append cmd.CreateParameter("@Termo", adVarChar, adParamInput, 500, Termo)
                cmd.Parameters.Append cmd.CreateParameter("@Verificar", adBoolean, adParamInput, 500, Verificar)
                cmd.Execute , , adExecuteNoRecords
            Else
                cmd.CommandText = "UPDATE tblTermos SET tblTermos.Excluido = False, tblTermos.id_Grupo = @Grupo, tblTermos.Verificar = @Verificar WHERE tblTermos.Termo = @Termo"
                cmd.Parameters.Append cmd.CreateParameter("@Grupo", adVarChar, adParamInput, 500, Grupo)
                cmd.Parameters.Append cmd.CreateParameter("@Verificar", adBoolean, adParamInput, 500, Verificar)
                cmd.Parameters.Append cmd.CreateParameter("@Termo", adVarChar, adParamInput, 500, Termo)
                cmd.Execute , , adExecuteNoRecords
            End If
            Acao = "cadastrado"
        Else
            Fim = True
            GoTo Fim
        End If
    Else
        If MsgBox("Deseja realmente atualizar o termo """ & Termo & """ com as informações abaixo?" & vbNewLine & _
        "- Abreviação: " & TrataAbreviacao(Abreviacao) & vbNewLine & _
        "- Grupo: """ & trim(cboxGrupo.Value) & """" & vbNewLine & _
        "- Verificar: """ & cboxVerificar.Value & """", vbYesNo + vbQuestion, "Atualizar termo") = vbYes Then
            cmd.CommandText = "UPDATE tblTermos SET tblTermos.id_Grupo = @Grupo, tblTermos.Verificar = @Verificar WHERE tblTermos.Termo = @Termo"
            cmd.Parameters.Append cmd.CreateParameter("@Grupo", adVarChar, adParamInput, 500, Grupo)
            cmd.Parameters.Append cmd.CreateParameter("@Verificar", adBoolean, adParamInput, 500, Verificar)
            cmd.Parameters.Append cmd.CreateParameter("@Termo", adVarChar, adParamInput, 500, Termo)
            cmd.Execute , , adExecuteNoRecords
            Acao = "atualizado"
        Else
            Fim = True
            GoTo Fim
        End If
    End If

    cmd.CommandText = "SELECT tblTermos.id FROM tblTermos WHERE tblTermos.Termo = @Termo"
    cmd.Parameters.Append cmd.CreateParameter("@Termo", adVarChar, adParamInput, 500, Termo)
    Set rst = cmd.Execute

    id_Termo = rst.Fields("id").Value

    cmd.CommandText = "INSERT INTO tblAbreviacoes (id_Termo, Abreviacao, Alterado) VALUES (@id_Termo, 'teste', '2015-02-02 10:10:10')"
    cmd.Parameters.Append cmd.CreateParameter("@id_Termo", adInteger, adParamInput, 500, id_Termo)
    cmd.Execute , , adExecuteNoRecords

Fim:

    DesconectaBanco cnn, rst, cmd

    If Fim = False Then
        Call AtualizarLista
        MsgBox "O termo """ & Termo & """ foi " & Acao & " com sucesso!", vbOKOnly + vbInformation, "Editar termos"
    End If

    Exit Sub

TrataErro:

    TrataErro "Erro durante a execução do procedimento ""SalvarTermo"" do form ""frmEditar""."

End Sub

In the line where I have the "Execute" command (below), this is where the error happens:

cmd.CommandText = "INSERT INTO tblAbreviacoes (id_Termo, Abreviacao, Alterado) VALUES (@id_Termo, 'teste', '2015-02-02 10:10:10')"
cmd.Execute , , adExecuteNoRecords

The following message is displayed: "Incompatible data type in criterion expression."

I think that this error happens due to the incompatibility of the data type of the database with what I inserted in my parameter, however in the database the data is type "Long integer" and already tried to put in the parameter "adBigInt", "adInteger "," adVarChar ", among others and still did not work. These types of data can be found at the link below.

link

Would anyone know how to help me?

Thank you.

    
asked by anonymous 06.04.2015 / 21:29

1 answer

1

Hello,

The issue has been resolved. I was not removing the parameters of the command object from the old queries, so the object performed certain action with incompatible data.

I added the following commands after each line with "cmd.Execute" to remove the parameters:

For i = 0 To cmd.Parameters.Count - 1
    cmd.Parameters.Delete (0)
Next

Now everything is working!

    
10.04.2015 / 18:47