RUN-TIME ERROR 3709

JAMESBOND007 14/06/2010 11:08:09
#344742
A operação solicitada requer um objeto OLE DB Session, para o qual não há suporte do provedor atual.


Private Sub MDIForm_Load()
Mdibutton = GetWindowLong(Me.hwnd, GWL_STYLE)

[ô]Retira o minimizar
[ô]Mdibutton = Mdibutton And Not (WS_MINIMIZEBOX)
[ô]Retira o maximizar
Mdibutton = Mdibutton And Not (WS_MAXIMIZEBOX)
Mdibutton = SetWindowLong(Me.hwnd, GWL_STYLE, Mdibutton)

If Not Dir(App.Path & [Ô]\imgfundo.jpg[Ô]) = [Ô][Ô] Then
Image1.Picture = LoadPicture(App.Path & [Ô]\imgfundo.jpg[Ô])
Else
Image1.Picture = LoadPicture([Ô][Ô])
End If

With cmd_conexao
.ActiveConnection = conexao
.CommandType = adCmdText
.CommandText = [Ô]Select * from config;[Ô]
Set rst_conexao = .Execute
End With
If Not (rst_conexao.EOF And rst_conexao.BOF) = True Then
For Each impressora In Printers
If impressora.DeviceName = rst_conexao!imp Then
Set Printer = impressora
Exit For
End If
Next
End If
End Sub
MARCELO.TREZE 14/06/2010 11:35:24
#344747
Primeiro vá em Lá em cima em PROJECT / REFERENCES... e selecione Microsoft ActiveX 2.8 Object Library

depois em seu código você deve declara o Objeto assim por exemplo

Dim cmd_conexao As New ADODB.Connection


é mais ou menos isso que está acontecendo
JAMESBOND007 14/06/2010 11:38:59
#344748
objeto requerido!
e volta pra mesma linha de conexao
JAMESBOND007 14/06/2010 11:43:52
#344751
eu uso esse Microsoft ActiveX 2.8 Object Library
MARCELO.TREZE 14/06/2010 11:45:26
#344752
tem como vc postar o restante do código deste form?
JAMESBOND007 14/06/2010 11:52:03
#344753
MODULO
[ô]Public conexao As New ADODB.Connection [ô]variavel objeto de controle do banco de dado como o data
Public conexao As New ADODB.Connection
Public cmd_conexao As New ADODB.Command [ô]variavel de controle do tipo de operação
Public cmd_conexao2 As New ADODB.Command [ô]variavel de controle do tipo de operação
Public rst_conexao As New ADODB.Recordset [ô]recordset da tabela

[ô]variavel q define impressora padrao
Public prt As String
Public login As String

Function conectar()
On Error GoTo erro
If ADO_CompactarDB(App.Path & [Ô]\dados\dbsis.mdb[Ô], App.Path & [Ô]\dbtmp.mdb[Ô]) = False Then
MsgBox [Ô]Houve um erro inesperado ao reparar o banco de dados .[Ô], vbCritical, [Ô]Reparação[Ô]
End If
conexao.ConnectionString = [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source= [Ô] & App.Path & [Ô]\Dados\dbsis.mdb;Persist Security Info=False[Ô]
conexao.Open
Exit Function
erro:
MsgBox [Ô]Impossivel estabelecer conexão com o banco de dados[Ô] + Chr$(13) + [Ô]O Sistema sera finalizado[Ô], vbInformation
End
End Function

Function disconect()
Set conexao = Nothing
Set cmd_conexao = Nothing
Set cmd_conexao2 = Nothing
Set rst_conexao = Nothing
End Function

LINHA DE CODIGO TODA

Private Declare Function SetWindowLong Lib [Ô]user32[Ô] Alias [Ô]SetWindowLongA[Ô] (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib [Ô]user32[Ô] Alias [Ô]GetWindowLongA[Ô] (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const GWL_STYLE As Long = (-16)

Private Sub MDIForm_Load()
Mdibutton = GetWindowLong(Me.hwnd, GWL_STYLE)

[ô]Retira o minimizar
[ô]Mdibutton = Mdibutton And Not (WS_MINIMIZEBOX)
[ô]Retira o maximizar
Mdibutton = Mdibutton And Not (WS_MAXIMIZEBOX)
Mdibutton = SetWindowLong(Me.hwnd, GWL_STYLE, Mdibutton)

If Not Dir(App.Path & [Ô]\imgfundo.jpg[Ô]) = [Ô][Ô] Then
Image1.Picture = LoadPicture(App.Path & [Ô]\imgfundo.jpg[Ô])
Else
Image1.Picture = LoadPicture([Ô][Ô])
End If

With cmd_conexao
.ActiveConnection = conexao
.CommandType = adCmdText
.CommandText = [Ô]Select * from config;[Ô]
Set rst_conexao = .Execute
End With
If Not (rst_conexao.EOF And rst_conexao.BOF) = True Then
For Each impressora In Printers
If impressora.DeviceName = rst_conexao!imp Then
Set Printer = impressora
Exit For
End If
Next
End If
End Sub

Private Sub MDIForm_Resize()
Picture1.Cls
Picture1.Visible = True
Picture1.AutoRedraw = True
Picture1.Height = Me.Height
[ô]Para centralizar a imagem no fundo
Dim wid As Integer, heig As Integer
Dim imgw As Integer, imgd As Integer
wid = 15240
heig = 9505
Image1.Stretch = False
imgw = Image1.Width
imgd = Image1.Height
Image1.Stretch = True

ProgressBar1.Visible = False
ProgressBar1.Top = Picture1.Height / 2 - ProgressBar1.Height / 2
ProgressBar1.Left = Picture1.Width / 2 - ProgressBar1.Width / 2

[ô]manter proporção
[ô]If Image1.Height > Image1.Width Then
[ô] Image1.Height = heig
[ô] Image1.Width = ((Image1.Height * wid) / heig)
[ô] Image1.Top = 40
[ô] Image1.Left = Picture1.Width / 2 - Image1.Width / 2
[ô]Else
[ô] Image1.Width = wid
[ô] Image1.Height = ((Image1.Width * heig) / wid)
[ô] Image1.Left = 55
[ô] Image1.Top = Picture1.Height / 2 - Image1.Height / 2
[ô]End If
[ô]Image1.Top = Picture1.Height / 2 - Image1.Height / 2
[ô]Image1.Left = Picture1.Width / 2 - Image1.Width / 2

[ô]ou expandir a imagem por todo o fundo
Image1.Stretch = True
Image1.Top = 0
Image1.Left = 0
Image1.Height = Picture1.Height
Image1.Width = Picture1.Width
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
If MsgBox([Ô]Deseja realmente finalizar o Sistema?[Ô], vbQuestion + vbYesNo, [Ô]Finalizar ?[Ô]) = vbYes Then
If MsgBox([Ô]Deseja Realizar o Backup antes de Sair?[Ô], vbQuestion + vbYesNo, [Ô]Backup[Ô]) = vbYes Then
gerabackup
End If
disconect
End
End If
Cancel = 1
End Sub

Private Sub mnu_os_Click()
frm_os.Show 1
End Sub

Private Sub mnu_skin_Click()
[ô]frm_skin.Show 1
End Sub

Private Sub mnucadcli_Click()
frm_cadcli.Show 1
End Sub

Private Sub mnucadfor_Click()
frm_cadfor.Show 1
End Sub

Private Sub mnucadoperador_Click()
frm_cadoperador.Show 1
End Sub

Private Sub mnucados_Click()
frm_os.Show 1
End Sub

Private Sub mnucadpro_Click()
frm_cadpro.Show 1
End Sub

Private Sub mnucaipagbaix_Click()
frm_baixapag.Show 1
End Sub

Private Sub mnucaipaglanc_Click()
frm_lancpag.Show 1
End Sub

Private Sub mnucaireclanc_Click()
frm_lacreceber.Show 1
End Sub

Private Sub mnucad_click()
If login = [Ô][Ô] Then Exit Sub
End Sub

Private Sub mnucompromisso_Click()
frm_compromissos.Show 1
End Sub

Private Sub mnucontpagar_Click()
frm_contaspagar.Show 1
End Sub


Private Sub mnuimpresorap_Click()
frm_impressorap.Show 1
End Sub

Private Sub mnuprod_Click()
If login = [Ô][Ô] Then Exit Sub
End Sub

Private Sub mnufinance_click()
If login = [Ô][Ô] Then Exit Sub
End Sub

Private Sub mnucont_click()
If login = [Ô][Ô] Then Exit Sub
End Sub

Private Sub mnuprecos_click()
If login = [Ô][Ô] Then Exit Sub
End Sub

Private Sub mnucons_click()
If login = [Ô][Ô] Then Exit Sub
End Sub

Private Sub mnurecibo_Click()
frm_recibo.Show 1
End Sub

Private Sub mnurelat_click()
If login = [Ô][Ô] Then Exit Sub
End Sub
Private Sub mnuconscaixa_Click()
frm_consultacaixa.Show 1
End Sub

Private Sub mnuconsprecvend_Click()
frm_consprecovenda.Show 1
End Sub

Private Sub mnucontreceb_Click()
frm_contaspagar.Show 1
End Sub

Private Sub mnucontreceber_Click()
frm_contasreceber.Show 1
End Sub

Private Sub mnufinentrsaid_Click()
frm_livrocaixa.Show 1
End Sub

Private Sub mnuprodajustest_Click()
frm_ajustest.Show 1
End Sub

Private Sub mnuprodcomp_Click()
frm_compras.Show 1
End Sub

Private Sub mnuprodorc_Click()
frm_or.Show 1
End Sub

Private Sub mnuprodvend_Click()
frm_venda.Show 1
End Sub

Private Sub mnuseggerar_Click()
disconect
gerabackup
conectar
End Sub

Private Sub mnusegrestaura_Click()
Dialog.DialogTitle = [Ô]Restaurar Backup[Ô]
Dialog.InitDir = App.Path & [Ô]\Backup[Ô]
Dialog.Filter = [Ô]Arquivos de Backup (*.bkp)|*.bkp[Ô]
Dialog.DefaultExt = [Ô]*.bkp[Ô]
Dialog.ShowOpen
If Dialog.FileName = [Ô][Ô] Then
Exit Sub
End If
disconect
Kill App.Path & [Ô]\dados\*.mdb[Ô]
If CopiaArquivo(Dialog.FileName, App.Path & [Ô]\dados\dbsis.mdb[Ô]) Then
MsgBox [Ô]Restauração concluida com sucesso![Ô], vbOKOnly, [Ô]backup[Ô]
Else
MsgBox [Ô]Não foi possivel realizar a restauração![Ô], vbOKOnly, [Ô]backup[Ô]
End If
conectar
End Sub

Private Sub mnuutillogof_Click()
If mnuutillogof.Caption = [Ô]Logoff do Operador[Ô] Then
If MsgBox([Ô]Deseja Realmente Realizar o Logoff[Ô], vbYesNo, [Ô]Logoff[Ô]) = vbNo Then Exit Sub
Set conexao = Nothing
Set cmd_conexao = Nothing
Set rst_conexao = Nothing
mnuutillogof.Caption = [Ô]Login do Operador[Ô]
Else
frm_entrada.txtcod.Text = [Ô][Ô]
frm_entrada.txtsenha.Text = [Ô][Ô]
frm_entrada.lblnome.Caption = [Ô][Ô]
Load frm_entrada
frm_entrada.Show
mnuutillogof.Caption = [Ô]Logoff do Operador[Ô]
End If
End Sub

Private Sub mensagem()
Msg.Abrir [Ô]Nenhum Operador Logado[Ô], ok, RmInformação, [Ô]SISLOJA[Ô]
End Sub

Private Sub mnuutilparamet_Click()
frm_dadosemp.Show 1
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
If Button = [Ô]Clientes[Ô] Then
frm_cadcli.Show 1
ElseIf Button = [Ô]Produtos[Ô] Then
frm_cadpro.Show 1
ElseIf Button = [Ô]Ordem de Serviço[Ô] Then
frm_os.Show 1
ElseIf Button = [Ô]Caixa[Ô] Then
frm_livrocaixa.Show 1
ElseIf Button = [Ô]Backup[Ô] Then
mnuseggerar_Click
ElseIf Button = [Ô]Fornecedores[Ô] Then
frm_cadfor.Show 1
End If
End Sub

Private Sub gerabackup()
Dim Arquivo As String
Arquivo = Format(Day(Date), [Ô]00[Ô]) & [Ô]-[Ô] & Format(Month(Date), [Ô]00[Ô]) & [Ô]-[Ô] & Format(Year(Date), [Ô]0000[Ô]) & [Ô].bkp[Ô]
If ExisteArquivo(App.Path & [Ô]\backup\[Ô] & Arquivo) Then
If MsgBox(UCase(Arquivo) & Chr(13) & Chr(10) & [Ô]O Arquivo já existe![Ô] & vbCrLf & [Ô]Sobrepor?[Ô], vbQuestion + vbYesNo, [Ô]Backup[Ô]) = vbYes Then
Kill (App.Path & [Ô]\backup\[Ô] & Arquivo)
Else
MsgBox [Ô]Backup Cancelado![Ô], vbOKOnly, [Ô]backup[Ô]
Exit Sub
End If
End If
If CopiaArquivo(App.Path & [Ô]\Dados\dbsis.mdb[Ô], App.Path & [Ô]\Backup\[Ô] & Arquivo, ProgressBar1) Then
MsgBox [Ô]Backup relizado com sucesso![Ô], vbOKOnly, [Ô]backup[Ô]
Else
MsgBox [Ô]Não foi possivel realizar o Backup![Ô], vbOKOnly, [Ô]backup[Ô]
End If
End Sub
Tópico encerrado , respostas não são mais permitidas
Voltar