Olá,
Estou desenvolvendo um código em VBA no Excel 2010 em conjunto com um banco Acces 2010.
Neste código, utilizo o ADO Command para manipular os dados no banco, porém estou recebendo uma mensagem de erro em um determinado trecho do código.
Segue abaixo o código:
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
Na linha de onde tenho o comando "Execute" (abaixo), é onde o erro acontece:
cmd.CommandText = "INSERT INTO tblAbreviacoes (id_Termo, Abreviacao, Alterado) VALUES (@id_Termo, 'teste', '2015-02-02 10:10:10')"
cmd.Execute , , adExecuteNoRecords
A seguinte mensagem é exibida: "Tipo de dados incompatível na expressão de critério."
Eu imagino que este erro aconteça devido à incompatibilidade do tipo de dado do banco com o que eu inseri no meu parâmetro, porém no banco o dado é tipo "Inteiro longo" e já tentei colocar no parâmetro "adBigInt", "adInteger", "adVarChar", entre outros e mesmo assim não funcionou. Estes tipos de dados podem ser encontrados no link abaixo.
https://msdn.microsoft.com/en-us/library/windows/desktop/ms675318(v=vs.85).aspx
Será que alguém saberia me ajudar?
Obrigado.