Run-Time error 30006

alexandro.oliveira · Maio 3, 2009

Ola companheiros do forum, estou iniciando na area de pogramaçao e preciso de ajuda dos mais experiente claro se quizerem me dar esta força.

Tenho um programa deixado por um outro programador e que agora ele esta me dando erro no formulario de pesquisa o primeiro erro dado foi Run-time error 30006 e com este erro uma outro membro de um outro forum de disse o que eu poderia fazer é criar dois botões de primeiro e proximo e assim me passou um script, me baseando neste script fui colocando no programa, mais esta dando erro ainda, vou postar o script deste form e conto com ajuda de vcs amigon

'Inclusao Option Explicit
'Private BD
'Private RS
Option Explicit
Private BD As New ADODB.Connection
Private RS As ADODB.Recordset
Dim prg As String
Public Sub setPrg(prgRelacionar As String)
prg = prgRelacionar
End Sub
Private Sub cmdExcel_Click()
GerarExcel gridJovens, "Jovens Banco de Talentos"
End Sub

Private Sub cmdIncluirProcSeletivo_Click()
Dim sql As String
If prg = "" Then Exit Sub
With gridJovens
	If participouProcessoEmpresa(.TextMatrix(.RowSel, 1), prg) Then
		If MsgBox("Esse Jovem já participou de um Processo Seletivo nessa Empresa e não foi Aprovado Tem Certeza que gostaria de Inclui-lo nesse processo Seletivo?", vbYesNo, "Confirmação") = vbNo Then
			Exit Sub
		End If
	End If
	If .TextMatrix(.RowSel, 10) = "Participando de Processo Seletivo" Then
		MsgBox "Esse Jovem já esta participando de um Processo Seletivo", vbCritical, "Não é possivel Incluir o Jovem"
		Exit Sub
	End If
	If MsgBox("Encaminhar o Jovem " & .TextMatrix(.RowSel, 2) & " para o Processo Seletivo nº " & prg & " ?", vbYesNo) = vbYes Then
		sql = "insert into jovensvaga (idVaga,nome,cpf,rg,dataEncaminhamento,idProspeccao) values(" & idPRG(prg) & ",'" & .TextMatrix(.RowSel, 2) & "','" & .TextMatrix(.RowSel, 3) & "','" & .TextMatrix(.RowSel, 4) & "', '" & Format(Date, "YYYY\/MM\/DD") & "'," & .TextMatrix(.RowSel, 1) & ")"
		BD.Execute sql
		.TextMatrix(.RowSel, 10) = "Participando de Processo Seletivo"
		frmvagasJovensEncaminhados.carregarJovensEncaminhados
	End If

End With
End Sub
Private Function participouProcessoEmpresa(id As String, prg As String) As Boolean
Dim sql As String
Dim idempresa As Integer
Dim proc As ADODB.Recordset
Set proc = CreateObject("ADODB.Recordset")
idempresa = pesquisaBD("vagas", "idEmpresa", "id", idPRG(prg))
sql = "SELECT  vagas.idempresa FROM jovensvaga LEFT JOIN vagas ON jovensvaga.idvaga = vagas.id WHERE (((jovensvaga.idprospeccao)=" & id & "));"
proc.Open sql, BD, 1, 1, 1
Dim cont As Integer
cont = contRecord(proc)
For i = 1 To cont
	 If proc(0) = idempresa Then
			participouProcessoEmpresa = True
			Exit Function
	 End If
	proc.MoveNext
Next
participouProcessoEmpresa = False
End Function
Private Sub cmdPesquisar_Click()
carregarPesquisa
End Sub

Private Sub cmdPrimeiro_Click()
carregarPesquisa True
End Sub

Private Sub cmdProximo_Click()
carregarPesquisa False
End Sub

Private Sub Form_Activate()
cmdIncluirProcSeletivo.Visible = prg <> ""
End Sub

Private Sub Form_Load()
'abre a conexao inclusao
BD.CursorLocation = adUseClient
BD.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=PC-DATACONTROL;PORT=3306;database=sgespro;USER=root;pwd=119159;OPTION=3;"
'carrega o recorset
Set RS = BD.Execute("select prospdadospessoais.id, prospdadospessoais.nome, prospdadospessoais.cpf, prospdadospessoais.rg, prospdadospessoais.dtnascimento, prospinclusao.tipoinclusao, prospdadosresidenciais.uf, prospdadosresidenciais.cidade, prospdadosresidenciais.regiao, prospinclusao.responsavel, prospinclusao.fonte, prospinclusao.empresaparceira, prospdadospessoais.usuario, prospdadospessoais.dataregistro, prospinclusao.statusjovem, prospinclusao.turma FROM prospinclusao , prospdadosresidenciais , prospdadospessoais Where prospdadosresidenciais.id = prospdadospessoais.id and prospinclusao.id = prospdadospessoais.id order By prospdadospessoais.nome")
configurarCMDS Me
configurargrid
AdicionarEstado cboEstado
carregarCombo cboRegiao, "zona", "id", "zona"
carregarCombo cboTipoInclusao, "tipoInclusaojovens", "id", "tipoInclusao"
carregarCombo cboEmpresaParceira, "empresasParceiras", "id", "nomefantasia", False
'Inclusao
carregarPesquisa False
End Sub

Private Sub configurargrid()
With gridJovens
	'Inclusao
	.Clear
	.Cols = 17
	.FixedCols = 0
	.Rows = 1

	.ColWidth(0) = 60
	.ColWidth(1) = 800
	.ColAlignment(1) = vbCenter
	.TextMatrix(0, 1) = "Id"

	.ColWidth(2) = 4000
	.ColAlignment(2) = vbCenter
	.TextMatrix(0, 2) = "Nome"

	.ColWidth(3) = 1500
	.ColAlignment(3) = vbCenter
	.TextMatrix(0, 3) = "CPF"


	.ColWidth(4) = 1500
	.ColAlignment(4) = vbCenter
	.TextMatrix(0, 4) = "RG"

	.ColWidth(5) = 1500
	.ColAlignment(5) = vbCenter
	.TextMatrix(0, 5) = "idade"
	
	.ColWidth(6) = 2000
	.ColAlignment(6) = vbCenter
	.TextMatrix(0, 6) = "Tipo Inclusão"

	.ColWidth(7) = 800
	.ColAlignment(7) = vbCenter
	.TextMatrix(0, 7) = "Estado"

	.ColWidth(8) = 2000
	.ColAlignment(8) = vbCenter
	.TextMatrix(0, 8) = "Cidade"

	.ColWidth(9) = 1500
	.ColAlignment(9) = vbCenter
	.TextMatrix(0, 9) = "Região"
	
	.ColWidth(10) = 3000
	.ColAlignment(10) = vbCenter
	.TextMatrix(0, 10) = "Proc Seletivo"
	
	.ColWidth(11) = 3000
	.ColAlignment(11) = vbCenter
	.TextMatrix(0, 11) = "Indicado"
	
	.ColWidth(12) = 3000
	.ColAlignment(12) = vbCenter
	.TextMatrix(0, 12) = "Fonte"
	
	.ColWidth(13) = 3000
	.ColAlignment(13) = vbCenter
	.TextMatrix(0, 13) = "Empresa Parceira"
	
	 .ColWidth(14) = 3000
	.ColAlignment(14) = vbCenter
	.TextMatrix(0, 14) = "Prosp"
	
	 .ColWidth(15) = 1000
	.ColAlignment(15) = vbCenter
	.TextMatrix(0, 15) = "Registro"
	
	 .ColWidth(16) = 1000
	.ColAlignment(16) = vbCenter
	.TextMatrix(0, 16) = "Turma CB"
	
End With
End Sub

Private Sub Form_Resize()
On Error GoTo erro
'Inclusao
cmdPrimeiro.Left = Me.Width - cmdPrimeiro.Width * 2
cmdProximo.Left = cmdPrimeiro.Left + cmdPrimeiro.Width + 10

cmdPrimeiro.Top = Me.Height - cmdPrimeiro.Height - 470
cmdProximo.Top = cmdPrimeiro.Top

With gridJovens
	'Inclusao
	.Left = 0
	.Top = 0
	'.Height = Me.Height - 2600
	.Width = Me.Width - 500
	.Height = cmdPrimeiro.Top
End With
erro:
End Sub

Private Function criterio() As String
Dim dtInicio As Date
Dim dtFim As Date
If txtId.Text <> "" Then
	criterio = " and prospdadospessoais.id = " & txtId.Text
Else
	If txtNome.Text <> "" Then
		criterio = " And prospdadospessoais.nome like '" & txtNome.Text & "%'"
	End If
	If chkMasculino.Value And Not chkFeminino.Value Then
		criterio = criterio & " and prospdadospessoais.sexomasculino = 1 "
		Else
		If Not chkMasculino.Value And chkFeminino.Value Then
			criterio = criterio & " and prospdadospessoais.sexofeminino = 1"
		End If
	End If
	
	If TxtCpf.Text <> "" Then
		criterio = criterio & " And prospdadospessoais.cpf = '" & TxtCpf.Text & "'"
	End If
	If txtInicioIdade.Text <> "" And TxtFimIdade.Text <> "" Then
		dtInicio = Format(Date, "DD\/MM") & "/" & (Format(Date, "YYYY") - CInt(txtInicioIdade.Text))
		dtFim = Format(Date, "DD\/MM") & "/" & (Format(Date, "YYYY") - CInt(TxtFimIdade.Text))
		criterio = criterio & " and prospdadospessoais.dtnascimento <= '" & Format(dtInicio, "YYYY\/MM\/DD") & "' And prospdadospessoais.dtnascimento >= '" & Format(dtFim, "YYYY\/MM\/DD") & "'"
	Else
		If txtInicioIdade.Text <> "" Then
			dtInicio = Format(Date, "DD\/MM") & "/" & (Format(Date, "YYYY") - CInt(txtInicioIdade.Text))
			criterio = criterio & " and prospdadospessoais.dtnascimento <= '" & Format(dtInicio, "YYYY\/MM\/DD") & "'"
		Else
			If TxtFimIdade.Text <> "" Then
				dtFim = Format(Date, "DD\/MM") & "/" & (Format(Date, "YYYY") - CInt(TxtFimIdade.Text))
				criterio = criterio & " and prospdadospessoais.dtnascimento >= '" & Format(dtFim, "YYYY\/MM\/DD") & "'"
			End If
		End If
	End If
	
	If cboEstado.ListIndex <> -1 Then
		criterio = criterio & " and prospdadosresidenciais.uf= '" & cboEstado.Text & "'"
	End If
	
	If txtCidade.Text <> "" Then
		criterio = criterio & " and prospdadosresidenciais.cidade like '" & txtCidade.Text & "%'"
	End If
	If cboRegiao.Text <> "" Then
		criterio = criterio & " and prospdadosresidenciais.regiao ='" & cboRegiao.Text & "'"
	End If
	If cboTipoInclusao.Text <> "" Then
		criterio = criterio & " and prospinclusao.tipoinclusao =" & cboTipoInclusao.ItemData(cboTipoInclusao.ListIndex)
	End If
	If txtResponsavel.Text <> "" Then
		If optResponsavel.Value Then
			criterio = criterio & " And prospinclusao.responsavel like '" & txtResponsavel.Text & "%'"
		Else
			criterio = criterio & " And prospinclusao.fonte like '" & txtResponsavel.Text & "%'"
		End If
	End If
	If txtturmaBasica.Text <> "" Then
		criterio = criterio & " and prospinclusao.turma like '" & txtturmaBasica.Text & "%'"
	End If
	If cboEmpresaParceira.ListIndex <> -1 Then
		criterio = criterio & " And prospinclusao.empresaparceira =  " & cboEmpresaParceira.ItemData(cboEmpresaParceira.ListIndex)
	End If
	If prg <> "" Then
		criterio = criterio & " and prospdadospessoais.Admitido = 0"
		criterio = criterio & " and prospdadospessoais.SimLiberadoProcesso = 1"
		criterio = criterio & " and (prospinclusao.StatusJovem = 4 or prospinclusao.StatusJovem is null) "
	End If
End If
End Function
'Incluido nos parentes dados
Private Sub carregarPesquisa(ByVal Primeiro As Boolean)
Dim sql As String
Dim registro As ADODB.Recordset
Set registro = CreateObject("ADODB.Recordset")

sql = " select prospdadospessoais.id,prospdadospessoais.nome, prospdadospessoais.cpf,prospdadospessoais.rg, prospdadospessoais.dtnascimento, prospinclusao.tipoinclusao, prospdadosresidenciais.uf, prospdadosresidenciais.cidade, prospdadosresidenciais.regiao, prospinclusao.responsavel,prospinclusao.fonte,prospinclusao.empresaparceira,pros
pdadospessoais.usuario,prospdadospessoais.dataregistro,prospinclusao.statusjovem
,
prospinclusao.turma "
sql = sql & " FROM prospinclusao ,prospdadosresidenciais ,prospdadospessoais "
sql = sql & " Where prospdadosresidenciais.id = prospdadospessoais.id and prospinclusao.id = prospdadospessoais.id " & criterio
sql = sql & " order By prospdadospessoais.nome"
'MsgBox (sql)
registro.Open sql, BD, 1, 1, 1
'Total exibido em cada passagem
Dim cont As Long
cont = 0
'cont = contRecord(registro)
lblQtd = cont
configurargrid

'Incluindo dados
'On Error Resume Next
If RS.EOF Or RS.BOF Then
	If Primeiro = True Then
		RS.MoveLast
	Else
		RS.MoveFirst
	End If
End If

'Inclusao
Dim i As Long
Dim j As Long

Do While Not (RS.EOF Or RS.BOF)
	cont = cont + 1
	
	With gridJovens
		.Rows = cont + 1
			For i = 1 To cont
				For j = 1 To .Cols - 8
					If Not IsNull(registro(j - 1)) Then .TextMatrix(i, j) = registro(j - 1).Value
				Next
				If IsDate(.TextMatrix(i, 5)) Then .TextMatrix(i, 5) = CalcularIdade(CDate(.TextMatrix(i, 5)), Date)
				If .TextMatrix(i, 6) <> "" Then .TextMatrix(i, 6) = pesquisaBD("tipoInclusaoJovens", "tipoinclusao", "id", .TextMatrix(i, 6))
				If estaNoBD("JovensVaga", "idProspeccao", "idProspeccao", .TextMatrix(i, 1)) Then
					If participandoProcesso(registro("id")) Then
						.TextMatrix(i, 10) = "Participando de Processo Seletivo"
					End If
				End If
		
				If Not IsNull(registro("responsavel")) Then .TextMatrix(i, 11) = registro("responsavel")
				If Not IsNull(registro("fonte")) Then .TextMatrix(i, 12) = registro("fonte")
				If Not IsNull(registro("empresaparceira")) Then .TextMatrix(i, 13) = pesquisaBD("empresasparceiras", "nomefantasia", "id", registro("empresaparceira"))
				If Not IsNull(registro("usuario")) Then .TextMatrix(i, 14) = registro("usuario")
				If Not IsNull(registro("dataregistro")) Then .TextMatrix(i, 15) = registro("dataregistro")
				If Not IsNull(registro("turma")) Then .TextMatrix(i, 16) = registro("turma")
				registro.MoveNext
			Next
	End With
registro.Close
	'aqui eu controlo quantos registros quero exibir
	If cont = 10000 Then Exit Do
	If Primeiro = True Then
		RS.MovePrevious
	Else
		RS.MoveNext
	End If
Loop

End Sub
Private Function participandoProcesso(id As String) As Boolean
Dim sql As String
Dim registro As ADODB.Recordset
Set registro = CreateObject("ADODB.Recordset")

sql = "select jovensvaga.idvAga,vagas.status from  jovensvaga LEFT JOIN vagas ON jovensvaga.idvaga = vagas.id where idprospeccao = " & id

registro.Open sql, BD, 1, 1, 1
Dim cont As Integer
cont = contRecord(registro)
For i = 1 To cont
		If registro("status") < 10 And registro("status") <> 4 Then
			participandoProcesso = True
			registro.Close
			Exit Function
		End If
		registro.MoveNext
Next
participandoProcesso = False
End Function
Private Sub gridJovens_DblClick()
With gridJovens
	frmProspeccao.limpar
	frmProspeccaoIncluirJovem.limpar
	pesquisaDadosFrm frmProspeccao, "id", .TextMatrix(.RowSel, 1)
	pesquisaDadosFrm frmProspecccaoComplementar, "id", .TextMatrix(.RowSel, 1)
	pesquisaDadosFrm frmProspeccaoIncluirJovem, "id", .TextMatrix(.RowSel, 1)
	pesquisaDadosFrm frmProspObservacaoGeral, "id", .TextMatrix(.RowSel, 1)
	frmProspeccao.setIncluir False
	frmProspeccao.txtId.Text = .TextMatrix(.RowSel, 1)
	frmProspeccao.txtNomeJovem.Text = .TextMatrix(.RowSel, 2)
	frmProspeccao.txtTipoInclusao.Text = .TextMatrix(.RowSel, 6)
	frmProspeccao.cmdAlterar.Enabled = True
	frmProspeccao.cmdPessoais_Click
	frmProspeccao.cmdProcessoSeletivo.Enabled = True
	frmProspeccao.txtusuario.Text = pesquisaBD("prospdadospessoais", "usuario", "id", .TextMatrix(.RowSel, 1))
	frmProspeccao.txtselecionador.Text = pesquisaBD("prospdadospessoais", "selecionador", "id", .TextMatrix(.RowSel, 1))
	frmProspeccao.TXTDataRegistro.Text = pesquisaBD("prospdadospessoais", "dataregistro", "id", .TextMatrix(.RowSel, 1))
	
	If prg <> "" Then
		frmProspeccao.setProcessoSeletivo (True)
	Else
		frmProspeccao.setProspecao (True)
	End If
	
	frmProspeccao.Show
End With
End Sub

Private Sub gridJovens_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
	PopupMenu menuOpcoes
End If
End Sub

Private Sub menuOrdenar_Click()
	gridJovens.Sort = flexSortGenericAscending
End Sub

scorpio · Maio 3, 2009

alexandro.oliveira,

Bem vindo ao fórum!

Sempre que postar suas dúvidas coloque somente o trecho que está com erro. Fica mais fácil de identificar o problema. http://forum.imasters.com.br/public/style_emoticons/default/thumbsup.gif

Utilize também as tags BBCode ( [code ] seu código aqui [/code ])

Espero sua resposta.

alexandro.oliveira · Maio 3, 2009

Bom dia Adminsitrador

Legal farei isto.

E continuo no aguardo de uma ajuda a este respeito.

A e ao compilar ele me da o erro nesta linha

Set RS = BD.Execute("select prospdadospessoais.id, prospdadospessoais.nome, prospdadospessoais.cpf, prospdadospessoais.rg, prospdadospessoais.dtnascimento, prospinclusao.tipoinclusao, prospdadosresidenciais.uf, prospdadosresidenciais.cidade, prospdadosresidenciais.regiao, prospinclusao.responsavel, prospinclusao.fonte, prospinclusao.empresaparceira, prospdadospessoais.usuario, prospdadospessoais.dataregistro, prospinclusao.statusjovem, prospinclusao.turma FROM prospinclusao , prospdadosresidenciais , prospdadospessoais Where prospdadosresidenciais.id = prospdadospessoais.id and prospinclusao.id = prospdadospessoais.id order By prospdadospessoais.nome")

Bem Utilizo banco Mysql - Local e os testes sao locais.

Grato mais uma vez

alexandro.oliveira · Maio 3, 2009

ja foi postado acima

Abraço

scorpio · Maio 3, 2009

Não sou administrador. :lol:

Tente utilizar o RS.Open, em vez do DB.Execute.

alexandro.oliveira · Maio 3, 2009

Scorpion Desculpa, pensei que fosse.

Tentei fazer o que você me falor mais tb nao funcionou

é por isto que coloquei a fonte inteira do forme aonde eu preciso modificar, para você analizarem e ai fica até mai facil entendeu

Grato amigon

Mário Monteiro · Maio 4, 2009

qual o erro que acusa nesta linha?

alexandro.oliveira · Maio 4, 2009

Mario boa tarde amigon

O erro na execucao aonde eu falo que ele para o erro que da é

Run-Time error '3704':

Operation is not allowed when the object is closed

Grato por me ajudar

Abraço

scorpio · Maio 4, 2009

Antes de fazer o RS.Open, coloque DB.Open.

'abre a conexao inclusao
BD.CursorLocation = adUseClient
BD.ConnectionString = "driver={MySQL ODBC 3.51 Driver};server=PC-DATACONTROL;PORT=3306;database=sgespro;USER=root;pwd=119159;OPTION=3;"
BD.Open '<##<#<#<#<#<#<<<<<<<<<<<<<<<<,,
'carrega o recorset
Set RS.Open "select prospdadospessoais.id, prospdadospessoais.nome, prospdadospessoais.cpf, prospdadospessoais.rg, prospdadospessoais.dtnascimento, prospinclusao.tipoinclusao, prospdadosresidenciais.uf, prospdadosresidenciais.cidade, prospdadosresidenciais.regiao, prospinclusao.responsavel, prospinclusao.fonte, prospinclusao.empresaparceira, prospdadospessoais.usuario, prospdadospessoais.dataregistro, prospinclusao.statusjovem, prospinclusao.turma FROM prospinclusao , prospdadosresidenciais , prospdadospessoais Where prospdadosresidenciais.id = prospdadospessoais.id and prospinclusao.id = prospdadospessoais.id order By prospdadospessoais.nome", BD
configurarCMDS Me
configurargrid
AdicionarEstado cboEstado
carregarCombo cboRegiao, "zona", "id", "zona"
carregarCombo cboTipoInclusao, "tipoInclusaojovens", "id", "tipoInclusao"
carregarCombo cboEmpresaParceira, "empresasParceiras", "id", "nomefantasia", False
'Inclusao
carregarPesquisa False
End Sub

Tente desse jeito.

Mário Monteiro · Maio 4, 2009

qual a linh exatamente?

a principio esta tentando usar algum objeto que ainda nao abriu ou que ja fechou

post a linha ou o trecho do codigo apontando a linha

alexandro.oliveira · Maio 4, 2009

Scorpio irmão

eu coloquei ja o comando BD.Open para abrir o banco blzinha continuei debugando e o mesmo erro acontece nesta linha.

e olha que fiz sem olhar o seu exemplo hehehehehehe

Veja a linha

Do While Not (RS.EOF Or RS.BOF)
	cont = cont + 1
	
	With gridJovens
		.Rows = cont + 1
			For i = 1 To cont
				For j = 1 To .Cols - 8
					If Not IsNull(registro(j - 1)) Then (.TextMatrix(i, j) = registro(j - 1).Value) -> fica amarelo o entre parentes .

alexandro.oliveira · Maio 4, 2009

Mario coloquei a linha cima irmão

Abraço

Mário Monteiro · Maio 4, 2009

registro é o seu recordset certo?

qual a logica disso ai, o que espera como resultado?

Arquivado

Run-Time error 30006

Recommended Posts

alexandro.oliveira 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

alexandro.oliveira 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

alexandro.oliveira 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

alexandro.oliveira 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Mário Monteiro 179

Compartilhar este post

Link para o post

Compartilhar em outros sites

alexandro.oliveira 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

scorpio 7

Compartilhar este post

Link para o post

Compartilhar em outros sites

Mário Monteiro 179

Compartilhar este post

Link para o post

Compartilhar em outros sites

alexandro.oliveira 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

alexandro.oliveira 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

Mário Monteiro 179

Compartilhar este post

Link para o post

Compartilhar em outros sites

Fixar div até atingir uma certa altura

Ajuda com Extends e envio para o banco

PHP+Codeginiter - Orientação para Impressão

Fóruns

Tempo Real

Informação importante