ERRO EM FUNCAO QUE CONECTA NO BANCO DE DADOS

USUARIO.EXCLUIDOS 28/02/2005 10:47:38
#70271
pessoal tenho um módulo que está fazendo minha conexão no banco. porém, está dando erro: na função de conexão:

Public Sub Conecta_BD()
Set conProdutos = New ADODB.Connection
With conProdutos
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=\\192.168.0.139\SP\SOFT\METTA\Sistema_Metta_Shering.mdb"
.Open
End With
End Sub

aí quando eu executo mue programa ele dá esse erro:

a conexão não pode ser usada para realizar esta operação. ela está fechada ou inválida neste contexto.

nota: o banco está no servidor, portanto esse número é o ip do servidor.

o que pode ser?

valeu
USUARIO.EXCLUIDOS 28/02/2005 12:29:22
#70314 Resposta escolhida
Cara eu não programo em VB, mais em asp eu uso o seguinte,

Dim StrCon
Dim conexao

Set conexao = Server.CreateObject("ADODB.Connection")
'StrCon ="DRIVER={Microsoft Access Driver (*.mdb)};DBQ="C:/dados/Banco"

Sub AbreConexao()
conexao.open StrCon
End sub

Sub FechaConexao()
Conexao.close
End Sub


Mais tenta usar alguma coisa parecida com isso, isso facilitou muito a minha vida com a conexao.

Valeus..
LREZANI 28/02/2005 12:47:01
#70318
Experimente este jeito.
  
Public Sub Conecta_BD() 
Set conProdutos = New ADODB.Connection 
With conProdutos 
.CursorLocation = adUseClient
.ConnectionString = "PROVIDER=Microsoft.Jet.Oledb.4.0; Persist Security info=false; Data source=\\192.168.0.139\SP\SOFT\METTA\Sistema_Metta_Shering.mdb"
.Open
USUARIO.EXCLUIDOS 28/02/2005 12:55:51
#70321
cara dá esse erro:
a conexão não pode ser usada para realizar esta operação. ela está fechada ou inválida neste contexto.

e vai para esta linha

rsProdutos.Open strsql, ConProdutos, adOpenForwardOnly, adLockReadOnly, adCmdText
LREZANI 28/02/2005 13:05:30
#70325
Altere isto
 rsProdutos.Open strsql, ConProdutos, adOpenForwardOnly, adLockReadOnly, adCmdText

Para
 rsProdutos.Open strsql, ConProdutos, adOpenStatic, adLockOptimistic, adCmdText
USUARIO.EXCLUIDOS 28/02/2005 13:15:17
#70328
cara continua dando o mesmo erro. mais acho que sei o que é, veja:

cara, eu acho que já sei qual o erro. vê se vc pode me ajudar.

existe um outro módulo de conexão ao banco, só que não fui eu que fiz. foi uma outra pessoa daqui da empresa.
o código desse módulo é:

' ******************************************************************************
' ******************* CARREGA O COMBO DOS PRODUTOS *****************************
' ******************************************************************************
Public Function CarComboProd() As Boolean
' ******************************************************************************
' ***** DEFINE AS CONEXÕES COM AS FONTES DE DADOS VIA ADO *********************
' ******************************************************************************
Dim ConexaoSQL As New ADODB.Connection
Dim rs As New ADODB.Recordset
' ***********************************************************************************
' ***** sql = VARIàVEL QUE VAI CONTER AS QUERIES EM TRASACT-SQL ***************
' ***** AbrirBanco = VARIàVEL QUE VAI CONTER AS INFORMAÇÕES PARA ABRIR O DATABASE ***
' ***********************************************************************************
Dim sql As String
Dim AbrirBanco As String
' ***********************************************************************************
' ********************************* VARIàVEIS PRIVADAS ******************************
' ***********************************************************************************

' ******************************************************************************
' ********************* ABRE O BANCO DE DADOS NO ACCESS ***********************
' ******************************************************************************
AbrirBanco = "DBQ="
AbrirBanco = AbrirBanco & LocalFonteDados & "\" & DBNome & ".mdb; "
AbrirBanco = AbrirBanco & "DRIVER={Microsoft Access Driver (*.mdb)}; "
AbrirBanco = AbrirBanco & "PWD=" & DBPassword
ConexaoSQL.Open AbrirBanco

'Dados_Produto_Incluir.txtdesconto.Text = frmcadastropedido.txtdesconto.Text

sql = "SELECT cadastroproduto.codigo_produto, "
sql = sql & "cadastroproduto.descricao, "
sql = sql & "cadastroproduto.fabricante_icms18, "
sql = sql & "cadastroproduto.desconto_maximo "
sql = sql & "From cadastroproduto "
sql = sql & "Order by cadastroproduto.codigo_produto"
Set rs = ConexaoSQL.Execute(sql)

Do While Not rs.EOF
Dados_Produto_Incluir.cboproduto.AddItem rs("codigo_produto")
Dados_Produto_Incluir.cboproduto.ItemData(Dados_Produto_Incluir.cboproduto.NewIndex) = rs("codigo_produto")
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
ConexaoSQL.Close
Set ConexaoSQL = Nothing
End Function

existe um outro módulo que é:

Option Explicit

' ********************************************************************
' ***************** VARIàVEIS DE CONFIGURAÇÃO DO BD ******************
' ********************************************************************
Public LocalFonteDados As String
Public DBNome As String
Public DBPassword As String

' ********************************************************************
' *********** VARIàVEIS DE CàLCULO DOS DADOS DO PRODUTO **************
' ********************************************************************
Public DescMax As Integer

e tem o módulo que fiz que é esse:

Public ConProdutos As ADODB.Connection
Public Sub Conecta_BD()
Set ConProdutos = New ADODB.Connection
With ConProdutos
.CursorLocation = adUseClient
.ConnectionString = "PROVIDER=Microsoft.Jet.Oledb.4.0; Persist Security info=false; Data source=\\192.168.0.139\SP\SOFT\METTA\Sistema_Metta_Shering.mdb"
.Open
End With

End Sub


Public Sub Desconecta_BD()
ConProdutos.Close
Set ConProdutos = Nothing
End Sub
Private Sub Main()
Conecta_BD
frmapresentacao.Show
End Sub
Public Sub Centraliza_MDIChild(Formulario As Form)
Formulario.Top = (Screen.Height) / 3 - Formulario.Height / 3
Formulario.Left = (Screen.Width) / 2 - Formulario.Width / 2
End Sub
Public Sub OrdenaListView(ByVal lvw As MSComctlLib.listview, ByVal Coluna_Cabecalho As MSComctlLib.ColumnHeader)
lvw.SortKey = Coluna_Cabecalho.Index - 1
lvw.Sorted = True
lvw.SortOrder = lvwAscending
End Sub

e eu acho que é isso que está causando o erro.

só que eu não sei qual dos três módulos que uso para chamar nessa linha que causa o erro:
rsProdutos.Open strsql, ConProdutos, adOpenForwardOnly, adLockReadOnly, adCmdText

qual seria?
USUARIO.EXCLUIDOS 28/02/2005 13:30:37
#70331
cara, fiz isto dentro do form que se encontra no listview:
rsProdutos.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source= C:\Sistema de Vendas\Sistema_Metta_Shering.mdb"

e mesmo assim continua dando o mesmo erro.

o que será, não é possível. olha minha função:

Private Sub Preencher_Listview()
Dim rsProdutos As ADODB.Recordset
Dim db As ADODB.Connection
Set rsProdutos = New ADODB.Recordset
Set db = New ADODB.Connection

Dim strsql As String
'rsProdutos.Open "PROVIDER=Microsoft.Jet.Oledb.4.0; Persist Security info=false; Data source=\\192.168.0.139\SP\SOFT\METTA\Sistema_Metta_Shering.mdb"
rsProdutos.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source= C:\Sistema de Vendas\Sistema_Metta_Shering.mdb"
'strsql = "SELECT Produtos.CódigoDoProduto, Produtos.NomeDoProduto, Categorias.Descrição, Fornecedores.NomeDaEmpresa, Fornecedores.NomeDoContato, Fornecedores.Telefone"
'strsql = strsql & " FROM Fornecedores"
'strsql = strsql & " INNER JOIN (Categorias INNER JOIN Produtos ON Categorias.CódigoDaCategoria = Produtos.CódigoDaCategoria) ON Fornecedores.CódigoDoFornecedor = Produtos.CódigoDoFornecedor;"
strsql = "select * from itens_pedido2"
db.Execute strsql
'rsProdutos.Open strsql, ConProdutos, adOpenForwardOnly, adLockReadOnly, adCmdText


'define o item da lista
Dim itemlst As ListItem

'limpa a lista
ListView1.ListItems.Clear
'cabecalho do listview
'listview_cabecalho

While Not rsProdutos.EOF

'insere o item do arquivo de dados
Set itemlst = ListView1.ListItems.Add(, , rsProdutos!codigo_produto)

'cada item precisa de um subitem para exibir na lista
itemlst.SubItems(1) = "" & rsProdutos!desconto
itemlst.SubItems(2) = "" & rsProdutos!qtde
itemlst.SubItems(3) = "" & rsProdutos!VALOR '
itemlst.SubItems(4) = "" & rsProdutos!valor_bruto_i
itemlst.SubItems(5) = "" & rsProdutos!valor_desconto_total_i

'vai para o proximo registro
rsProdutos.MoveNext
Wend

rsProdutos.Close
ListView1.Refresh
End Sub
USUARIO.EXCLUIDOS 28/02/2005 14:06:57
#70344
fiz essa conexão do load do form:

Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("\\192.168.0.139\SP\SOFT\METTA\Sistema_Metta_Shering.mdb")
Set rs = db.OpenRecordset("itens_pedido2", dbOpenTable)
Preencher_Listview

a função que carrega o listview:

Private Sub Preencher_Listview()

Dim strsql As String
strsql = "select * from itens_pedido2"
Set rs = db.OpenRecordset(strsql)


'define o item da lista
Dim itemlst As ListItem

'limpa a lista
ListView1.ListItems.Clear
'cabecalho do listview
'listview_cabecalho

Do While Not rs.EOF
'insere o item do arquivo de dados
'Set itemlst = ListView1.ListItems.Add(, , rsProdutos!codigo_produto)
Set itemlst = ListView1.ListItems.Add(, , CInt(rs("codigo_produto")))
'cada item precisa de um subitem para exibir na lista
'itemlst.SubItems(1) = "" & rsProdutos!desconto
itemlst.SubItems(2) = "" & rs!desconto
'itemlst.SubItems(2) = "" & rsProdutos!qtde
itemlst.SubItems(3) = "" & rs!qtde
'itemlst.SubItems(3) = "" & rsProdutos!VALOR
itemlst.SubItems(1) = "" & rs!VALOR
'itemlst.SubItems(4) = "" & rsProdutos!valor_bruto_i
itemlst.SubItems(4) = "" & rs!valor_bruto_i
'itemlst.SubItems(5) = "" & rsProdutos!valor_desconto_total_i
itemlst.SubItems(5) = "" & rs!valor_desconto_total_i

'vai para o proximo registro
rs.MoveNext
Loop

rs.Close
ListView1.Refresh
End Sub

acho que não é erro de conexão.
mais quando carrego o form ele dá esse erro:
type mismatch e vai para essa linha:

Set itemlst = ListView1.ListItems.Add(, , CInt(rs("codigo_produto")))

onde coigo_produto é numero no banco e como vc's podem ver transformei para inteiro, já que o listview não aceita números.
e dá o erro que te falei acima.

o que pde ser?
USUARIO.EXCLUIDOS 28/02/2005 16:26:46
#70376
galera comsegui carregar me listview.
para quem quiser o código é esse:

Private Sub preenche_lista()
On Error Resume Next
Tabela.Close
On erro GoTo Trataerro
Tabela.Open "SELECT * FROM itens_pedido2", Conexao

lstMostra.ListItems.Clear
listview_cabecalho

Do While Not Tabela.EOF
Set Lista = lstMostra.ListItems.Add(, , Tabela!codigo_produto)
Lista.SubItems(1) = "" & Tabela!desconto
Lista.SubItems(2) = "" & Tabela!qtde
Lista.SubItems(3) = "" & Tabela!VALOR
Lista.SubItems(4) = "" & Tabela!valor_bruto_i
Lista.SubItems(5) = "" & Tabela!valor_desconto_total_i
Lista.SubItems(6) = "" & Tabela!valor_liquido_i
Tabela.MoveNext
Loop
Exit Sub
Trataerro:
MsgBox Err.Description, vbCritical, "Erro no sistema"
End Sub

falow
Tópico encerrado , respostas não são mais permitidas
Voltar