ADO Command / Parameter in Excel (VBA)

Asked

Viewed 504 times

2

Hello,

I am developing a code in VBA in Excel 2010 in conjunction with a database Acces 2010.

In this code, I use ADO Command to manipulate the data in the database, but I am receiving an error message in a certain code snippet.

Follow 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

On the line where I have the command "Execute" (below), 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 the criterion expression."

I imagine this error happens due to the incompatibility of the database type with what I entered in my parameter, but in the database the data is type "Longint" and I tried to put in the parameter "adBigInt", "adInteger", "adVarChar", among others and even then it didn’t work. These types of data can be found in the link below.

https://msdn.microsoft.com/en-us/library/windows/desktop/ms675318(v=vs.85). aspx

Would anyone know to help me?

Thank you.

1 answer

1


Hello,

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

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

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

Now everything is working!

Browser other questions tagged

You are not signed in. Login or sign up in order to post.