[Resolvido] VB6 x SQL Server - Não grava em campo int

[Aquiles Brum 0]

Estou desenvolvendo um sistema em vb 6 e banco sql server. Venho enfrentando um problema estranho, quando vou gravar em um campo inteiro, recebo uma mensagem de que nao é possivel gravar. Alguém já enfrentou este tipo de problema?

 

Ps1: Em outros tipos de campo consigo gravar sem problemas;

 

Ps2: Fiquei na duvida de onde deveria ter postado, VB ou Banco. Ao moderador fique a vontade para mover meu tópico.

[Claudio Neto 3]

Olá Aquiles, primeiramente, seja bem vindo ao fórum. Visite nossas regras.

 

Sua dúvida está no lugar certo, pois provavelmente seu erro está no código. E peço que o poste aqui para darmos uma analisada.

 

Mas as possíveis causas do erro pode ser:

 

Ou você está tentando passar o valor como uma string, e não como número, ou seu campo inteiro na tabela é de autonumeração, e nesse caso não há necessidade nem pode ser passado nenhum valor. Se não for autonumeração, poste seu código mesmo (somente a parte do insert).

 

Abraços.

[Aquiles Brum 0]

Obrigado Claudio pela atenção. Em relação ao campo, ele não esta como autonumeração na tabela. Segue a parte do código que esta apresentando o problema:

 

if mblnInserindo Then
        rs.AddNew
            AtualizarCampos
        rs.Update
        
        MsgBox "Registro salvo com sucesso !"
        rs.MoveFirst
    Else
        rs.Update
        MsgBox "Registro alterado com sucesso !"
End If
    
AtualizarCampos

Private Sub AtualizarCampos()
   
  With rs
        If mblnInserindo Then
             .Fields("CD_BAIRRO") = CInt(lblCodigo.Caption)
        End If
            .Fields("DS_BAIRRO") = txtBairro.Text
        End With
  End Sub

[Claudio Neto 3]

Seu código não parece ter erros quanto a gravação do campo numérico.

 

Você disse que ele dá uma mensagem. Que mensagem dá?

[Aquiles Brum 0]

Seu código não parece ter erros quanto a gravação do campo numérico.

 

Você disse que ele dá uma mensagem. Que mensagem dá?

 

Run-time error '3265':

 

O item não pode ser encontrado na coleção correspondente ao nome ou ao ordinal solicitado.

[Claudio Neto 3]

o erro diz que isso:

Fields("CD_BAIRRO")

não existe.

 

Confere se o nome está igual ao da sua tabela.

[Aquiles Brum 0]

Eles são exatamente iguais. Dê uma olhada na tabela que esta no banco:

 

[Claudio Neto 3]

Isso está estranho.

 

Tem como abrir um pouco mais seu código. Poste desde a parte que está fazendo a consulta no banco.

[Aquiles Brum 0]

 

Option Explicit

 

Dim usuario, senha, servidor, BancoDados As String

Dim sql As String

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

 

'Variáveis de navegação

Private mblnAlterando As Boolean

Private mblnInserindo As Boolean

Private mblnNavegando As Boolean

 

Private mstrTransacao As String

 

Private Const mstrSQLConsulta = "SELECT CD_BAIRRO as Código, DS_BAIRRO as Bairro " & _

"FROM CAD_BAIRROS"

 

'Constante que define o numero do formularios

Const mstrCodFormulario As String = "2"

 

Private Sub cmbUF_Click()

EditouCampo

End Sub

 

Private Sub Form_Load()

 

On Error GoTo TrataErro

 

cn.Provider = "SQLOLEDB"

cn.Properties("Data Source").Value = "CAMPESTRE"

cn.Properties("Initial Catalog").Value = "DB_AEC"

cn.Properties("User ID").Value = "sa"

cn.Properties("Password").Value = "sa"

cn.Open

 

sql = "Select CD_BAIRRO, DS_BAIRRO from CAD_BAIRROS "

rs.CursorLocation = adUseClient

rs.Open sql, cn, adOpenForwardOnly, adLockPessimistic

 

'Busca o icone do formulario principal e formata

Me.Icon = frmPrincipal.Icon

Me.Width = 4680

Me.Height = 2280

 

 

If Not rs.EOF Then

Call MostraDados

Call AlterarPropBotao(2, False)

Else

' BloquearControles (False)

Call AlterarPropBotao(2, False)

Call AlterarPropBotao(3, False)

Call AlterarPropBotoesNavegacao(False)

End If

 

mblnAlterando = False

mblnInserindo = False

 

Exit Sub

TrataErro:

MsgBox Err.Number & " - " & Err.Description

 

End Sub

 

Private Sub MostraDados()

 

On Error GoTo TrataErro

 

mblnNavegando = True

 

With rs

If .BOF And .EOF Then

MsgBox "Não há dados para exibir ! "

Else

lblCodigo.Caption = .Fields("CD_BAIRRO")

txtBairro.Text = .Fields("DS_BAIRRO")

End If

End With

 

mblnNavegando = False

 

Exit Sub

Resume

TrataErro:

MsgBox Err.Number & " - " & Err.Description

 

End Sub

 

'Redimenciona e centraliza o formulário

Private Sub Form_Resize()

 

If Me.WindowState <> vbMinimized Then

Me.Width = 4680

Me.Height = 2280

Me.Left = ((frmPrincipal.Width - Me.Width) / 2) - 100 ' Centralizar form horizontalmente.

Me.Top = ((frmPrincipal.Height - 1400) - Me.Height) / 2 ' Centralizar form verticalmente

End If

 

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

 

On Error GoTo TrataErro

 

Dim intResposta As Integer

Dim intSalvou As Integer

 

If mblnAlterando Or mblnInserindo Then

intResposta = MsgBox("O registro atual ainda não foi salvo. Deseja salvá-lo?", vbQuestion + vbYesNoCancel)

 

If intResposta = vbYes Then

'salvar registro atual

SalvarRegistro intSalvou

If intSalvou = 0 Then Cancel = True

ElseIf intResposta = vbCancel Then

Cancel = True

End If

End If

 

rs.Close

Set rs = Nothing

cn.Close

Set cn = Nothing

 

Exit Sub

Resume

TrataErro:

MsgBox Err.Number & " - " & Err.Description

 

End Sub

 

Private Sub tlbCadastro_ButtonClick(ByVal Button As MSComctlLib.Button)

 

'On Error GoTo TrataErro

 

Dim intResposta As Integer

Dim intSalvou As Integer

 

If (mblnAlterando Or mblnInserindo) And Button.Index <> 2 Then

intResposta = MsgBox("O registro atual ainda não foi salvo. Deseja salvá-lo?", vbQuestion + vbYesNoCancel)

 

If intResposta = vbYes Then

SalvarRegistro intSalvou

If intSalvou = 0 Then Exit Sub

ElseIf intResposta = vbCancel Then

Exit Sub

Else

Call AlterarPropBotao(2, False)

mblnAlterando = False

mblnInserindo = False

End If

End If

 

Select Case Button.Index

 

Case 1: InserirRegistro

Case 2: SalvarRegistro

Case 3: ExcluirRegistro

Case 5: MoverPrimeiro

Case 6: MoverAnterior

Case 7: MoverProximo

Case 8: MoverUltimo

Case 9: Consulta

 

End Select

 

Exit Sub

Resume

'TrataErro:

' MsgBox Err.Number & " - " & Err.Description

End Sub

 

Private Sub InserirRegistro()

 

On Error GoTo TrataErro

 

Dim intResposta As Integer

 

If mblnAlterando Or mblnInserindo Then

intResposta = MsgBox("O registro atual ainda não foi salvo. Deseja salvá-lo?", vbQuestion + vbYesNoCancel)

 

If intResposta = vbYes Then

'salvar registro atual

SalvarRegistro

ElseIf intResposta = vbCancel Then

Exit Sub

End If

End If

 

mblnInserindo = True

mblnAlterando = False

 

' BloquearControles (True)

LimparControles

lblCodigo.Caption = "0"

Call AlterarPropBotao(2, True)

Call AlterarPropBotao(3, False)

 

Exit Sub

TrataErro:

MsgBox Err.Number & " - " & Err.Description

 

End Sub

 

Private Sub LimparControles()

 

mblnNavegando = True

 

lblCodigo.Caption = ""

txtBairro.Text = ""

mblnNavegando = False

 

End Sub

 

'INICIO SALVAR REGISTRO

Private Sub SalvarRegistro(Optional ByRef intSalvo As Integer)

 

'On Error GoTo TrataErro

 

Dim varPos As Variant

Dim intLoop As Integer

Dim strSQL As String

 

 

intLoop = 0

intSalvo = 0

 

'Se não estiver alterando e inserindo um novo registro, saí da procedure

If Not mblnAlterando And Not mblnInserindo Then Exit Sub

 

'Verifica se já foi feita a verificação de preenchimento dos campos

If Not VerificarCampos Then Exit Sub

 

' Se estiver inserindo, busca um novo código

If mblnInserindo Then

rs.Close

'Busca o último codigo e incrementa o proximo codigo

strSQL = "SELECT MAX(CD_BAIRRO) + 1 FROM CAD_BAIRROS"

rs.Open strSQL

lblCodigo.Caption = rs.Fields(0)

End If

 

' Se estiver inserindo o registro é gravado efetivamente. Senão a edição é atua_

' lizada

If mblnInserindo Then

rs.AddNew

AtualizarCampos

rs.Update

 

MsgBox "Registro salvo com sucesso !"

rs.MoveFirst

Else

rs.Update

MsgBox "Registro alterado com sucesso !"

End If

 

AtualizarCampos

 

If rs.EOF Then rs.MoveFirst

 

intSalvo = 1

mblnAlterando = False

mblnInserindo = False

 

Call AlterarPropBotao(2, False)

 

Exit Sub

Resume

'TrataErro:

' If Err.Number = 3022 Then

' If intLoop <> 5 Then

' lblCodigo.Caption = RetornarProximoCodigo("CAD_BAIRRO", "CD_BAIRRO", "1")

' intLoop = intLoop + 1

' Resume

' End If

' End If

 

' MsgBox Err.Number & " - " & Err.Description

 

End Sub

 

'ATUALIZA CAMPOS

Private Sub AtualizarCampos()

With rs

If mblnInserindo Then

.Fields("CD_BAIRRO") = lblCodigo.Caption

End If

.Fields("DS_BAIRRO") = txtBairro.Text

End With

End Sub

 

'EXCLUIR REGISTRO

Private Sub ExcluirRegistro()

 

On Error GoTo TrataErro

 

If MsgBox("Confirma exclusão do registro atual?", vbQuestion + vbYesNo) = vbNo Then

Exit Sub

End If

rs.Delete

rs.Requery

rs.MoveLast

 

If rs.EOF Then

LimparControles

' Call BloquearControles(False)

Call AlterarPropBotao(2, False)

Call AlterarPropBotao(3, False)

Call AlterarPropBotoesNavegacao(False)

Else

MostraDados

End If

Exit Sub

TrataErro:

If Err.Number = 3200 Then

MsgBox "Não foi possível excluir o registro, existem outros registros relacionados a ele!", vbInformation

Exit Sub

End If

 

MsgBox Err.Number & " - " & Err.Description

 

End Sub

 

'Move para o PRIMEIRO REGISTRO

Private Sub MoverPrimeiro()

With rs

If .BOF And .EOF Then 'Verifica se o arquivo esta vazio

MsgBox "Não há dados desta tabela no banco!", vbInformation

Else

.MoveFirst 'Move para o primeiro registro

MostraDados

End If

End With

End Sub

 

'Move para o REGISTRO ANTERIOR

Private Sub MoverAnterior()

With rs

If .BOF And .EOF Then

MsgBox "Não há dados desta tabela no banco!", vbInformation

Else

.MovePrevious

If .BOF Then

.MoveFirst

Else

MostraDados

End If

End If

End With

End Sub

 

'Move para o PRÓXIMO REGISTRO

Private Sub MoverProximo()

With rs

If .BOF And .EOF Then

MsgBox "Não há dados desta tabela no banco!", vbInformation

Else

.MoveNext

If .EOF Then

.MoveLast

Else

MostraDados

End If

End If

End With

End Sub

 

'Move para O ÚLTIMO REGISTRO

Private Sub MoverUltimo()

 

With rs

If .BOF And .EOF Then

MsgBox "Não há dados no arquivo ", vbInformation

Else

.MoveLast

MostraDados

End If

End With

 

End Sub

 

Private Sub AlterarPropBotao(intIndice As Integer, blnValor As Boolean)

 

tlbCadastro.Buttons(intIndice).Enabled = blnValor

 

End Sub

 

Private Sub AlterarPropBotoesNavegacao(blnValor As Boolean)

 

Dim intIndice As Integer

 

For intIndice = 5 To 8

tlbCadastro.Buttons(intIndice).Enabled = blnValor

Next

End Sub

 

'FUNÇÃO VERIFICAR CAMPOS

 

Private Function VerificarCampos() As Boolean

 

On Error GoTo TrataErro

 

VerificarCampos = False

 

If txtBairro.Text = "" Then

MsgBox "O campo BAIRRO é de preenchimento obrigatório!", vbInformation, "Cadastro de Bairros"

txtBairro.SetFocus

Exit Function

End If

 

VerificarCampos = True

 

Exit Function

TrataErro:

MsgBox Err.Number & " - " & Err.Description

End Function

 

Private Sub Consulta()

 

Dim f As New frmConsulta

Dim strRestricao As String

Dim colRetorno As Collection

Dim strcriterio As String

 

mstrTransacao = "SCI000037"

 

Me.MousePointer = vbHourglass

DoEvents

 

Set colRetorno = f.Consultar(mstrSQLConsulta, "", mstrTransacao)

 

If Not colRetorno Is Nothing Then

rs.FindFirst "CD_BAIRRO = " & colRetorno(1).Value

PreencherControles

End If

 

Me.MousePointer = vbDefault

 

End Sub

 

'VERIFICAÇÃO DE EDIÇÃO DE CAMPOS

 

Private Sub EditouCampo()

'Ativa a variável mblnAlterando quando o usuário altera algum campo

If Not mblnInserindo And Not mblnNavegando Then

mblnAlterando = True

Call AlterarPropBotao(2, True)

End If

End Sub

 

'Verifica BAIRRO

Private Sub txtBairro_Change()

Call EditouCampo

End Sub

 

'FORÇA O USO DE LETRAS MAIÚSCULAS NO CAMPO

 

Private Sub txtBairro_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

End Sub

[Aquiles Brum 0]

Só para commplementar: Estou conseguindo navegar e excluir os registros sem problemas, só pega na hora de adicionar.

[Claudio Neto 3]

Bom, uma possível causa do erro pode ser porque está usando alias quando faz a consulta. Tente utilizar os nomes como nos apelidos ao invés do nome original.

 

Olha só, achei um errinho em seu códifo aqui:

If .BOF And .EOF Then

Ele nunca será bof e eof ao mesmo tempo. Você precisa utilizar "or" ao invés de "and".

 

E nessa parte aqui:

If mblnInserindo Then
        rs.AddNew
            AtualizarCampos
        rs.Update
        
        MsgBox "Registro salvo com sucesso !"
        rs.MoveFirst
    Else
        rs.Update
        MsgBox "Registro alterado com sucesso !"
    End If
    
    AtualizarCampos

Porque está chamando a função AtualizarCampos duas vezes? Uma dentro do if e outra fora?

 

E o erro está apontando para essa linha: ??

.Fields("CD_BAIRRO") = lblCodigo.Caption

[Aquiles Brum 0]

E o erro está apontando para essa linha: ??

.Fields("CD_BAIRRO") = lblCodigo.Caption

Sim, quando tento gravar, o erro aponta para esta linha. Estou verificando também a consulta como você sugeriu.

 

Obrigado

[Aquiles Brum 0]

Pessoal, ontem na faculdade procurei um professor e ele resolveu o problema.

 

Removeu "rs.close" do inicio do if e criou um recordset auxiliar "rs_Aux". Usou o novo recordeset exclusivamente para esta rotina.

 

 

If mblnInserindo Then
rs.Close
'Busca o último codigo e incrementa o proximo codigo
strSQL = "SELECT MAX(CD_BAIRRO) + 1 FROM CAD_BAIRROS"
rs.Open strSQL
lblCodigo.Caption = rs.Fields(0)
End If


If mblnInserindo Then
'Busca o último codigo e incrementa o proximo codigo
strSQL = "SELECT MAX(CD_BAIRRO) + 1 FROM CAD_BAIRROS"
rs_Aux.Open strSQL, cn, adOpenForwardOnly, adLockPessimistic
lblCodigo.Caption = rs_Aux.Fields(0)
rs_Aux.Close
End If

Obrigado a todos que me ajudaram.

[scorpio 7]

Obrigado por postar como resolveu!

 

Abraços!!!

[Claudio Neto 3]

Isso resolveu seu problema?

 

Pelo que postou inicialmente pedindo ajuda, não vi nada de semelhante com o código que postou. Será que desde o início não havia entendido sua dúvida?

 

Nesse código que postou, nem sequer mostrou como fez seu insert, que antes (pelo que entendi) era o que estava dando problema.

 

Procure sempre detalhar bem suas dúvidas tentando ser objetivo nas suas questões, nos ajuda a te ajudar.

 

Abraços.