USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  caminho banco de dados
Rafael The Best
SÃO PAULO
SP - BRASIL
Postada em 17/02/2005 17:19 hs            

pessoal preciso de uma coisa.

tem um sistema aqui na empresa e ele está em um cliente. só lá está em umdeterminado caminho.
e pra não ficar mudando o caminho form por form coloquei isso.

sql = App.Path & "Sistema_Metta_Shering.mdb"

a istrução completa é essa:

Set ws = DBEngine.Workspaces(0)
 sql = App.Path & "Sistema_Metta_Shering.mdb"
Set db = ws.OpenDatabase(sql)    e está dando erro nessa linha

porque?
ele diz que não reconhece o caminho do banco.

alguém poderia me ajudar?

o código dessa tela que estou falando é essa:

'--------------------------------------------------------
' Cliente ................ Metta Serviços de Vendas Ltda
' Módulo ................. Sistema de Venda
' Formulário ............. Pedidos
'
'----------------+--------+----------+-------------------
' Data Conclusão | Versão | Analista | Atividade
'----------------+--------+----------+-------------------
' 01/06/2004     | 06.00  | Fernanda | Criação
'----------------+--------+----------+-------------------

Dim itemapagar As Integer
Dim sql     As String
Dim sql2    As String
Dim db      As Database
Dim ws      As Workspace
Dim rs      As Recordset

' ***************************************************************
' ***** FUNÇÃO QUE SUBSTITUÍ VÍRGULA POR PONTOS(VALOR NET)*******
' ***************************************************************
Public Function AjustaNum(Valor As String) As String
    Dim i As Integer
    Dim Virgula As Boolean
   
    Virgula = False
   
    For i = 1 To Len(Valor)
    If Mid(Valor, i, 1) = "," Then
        If Virgula = False Then
            AjustaNum = AjustaNum & "."
        End If
        Virgula = True
    Else
        AjustaNum = AjustaNum & Mid(Valor, i, 1)
    End If
    Next
End Function

' *********************************************************************
' ***** FUNÇÃO QUE CONFIGURA AS TECLAS QUE PODEM SER DIGITADAS ********
' *********************************************************************
Public Function TeclasPerm(Digito As Integer, Letras As Boolean, Numeros As Boolean, Auxiliares As Boolean, Especiais As Boolean, Proibidos As Boolean, Maiusculo As Boolean) As Integer

' Backspace = Sempre Habilitado
Select Case Digito
    Case 8 ' BackSpace
        TeclasPerm = Digito
End Select

' CTRL+C (Copiar) - Sempre Habilitado
Select Case Digito
    Case 3 ' CTRL+C
        TeclasPerm = Digito
End Select

' CTRL+X (Recortar) - Sempre Habilitado
Select Case Digito
    Case 24 ' CTRL+X
        TeclasPerm = Digito
End Select

' CTRL+V (Colar) - Sempre Habilitado
Select Case Digito
    Case 22 ' CTRL+V
        TeclasPerm = Digito
End Select

' Letras
If Letras = True Then
    Select Case Digito
        Case 97 To 122 ' De a - z
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 224 To 227 ' à, á, â, ã
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 231 ' Cedilha (ç)
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 233 To 234 ' é, ê
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 237 ' í
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 243 To 245 ' ó, ô, õ
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 250 ' ú
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 252 ' ü
            If Maiusculo = True Then
                TeclasPerm = Digito - 32
            Else
                TeclasPerm = Digito
            End If
        Case 65 To 90 ' De A - Z
            TeclasPerm = Digito
        Case 192 To 195 ' À, Á, Â, Ã
            TeclasPerm = Digito
        Case 199 ' Cedilha (Ç)
            TeclasPerm = Digito
        Case 201 To 202 ' É, Ê
            TeclasPerm = Digito
        Case 205 ' Í
            TeclasPerm = Digito
        Case 211 To 213 ' Ó, Ô, Õ
            TeclasPerm = Digito
        Case 218 ' Ú
            TeclasPerm = Digito
        Case 220 ' Ü
            TeclasPerm = Digito
    End Select
End If

' Numeros
If Numeros = True Then
    Select Case Digito
        Case 48 To 57 ' De 0 a 9
            TeclasPerm = Digito
    End Select
End If

' Auxiliares
If Auxiliares = True Then
    Select Case Digito
        Case 32 ' Espaço
            TeclasPerm = Digito
        Case 40 ' Abre parênteses
            TeclasPerm = Digito
        Case 41 ' Fecha parênteses
            TeclasPerm = Digito
        Case 43 ' Sinal de Somar (Mais)
            TeclasPerm = Digito
        Case 44 ' Vírgula
            TeclasPerm = Digito
        Case 45 ' Hifen
            TeclasPerm = Digito
        Case 46 ' Ponto Final
            TeclasPerm = Digito
        Case 47 ' Barra
            TeclasPerm = Digito
        Case 58 ' Dois pontos
            TeclasPerm = Digito
        Case 59 ' Ponto e Vírgula
            TeclasPerm = Digito
        Case 61 ' Sinal de Igual
            TeclasPerm = Digito
    End Select
End If

' Especiais
If Especiais = True Then
    Select Case Digito
        Case 33 ' Ponto de Exclamação
            TeclasPerm = Digito
        Case 36 To 38
            TeclasPerm = Digito
        Case 42 ' Asterisco
            TeclasPerm = Digito
        Case 60 ' Sinal de menor
            TeclasPerm = Digito
        Case 62 To 64
            TeclasPerm = Digito
        Case 91 To 96
            TeclasPerm = Digito
        Case 123 To 126
            TeclasPerm = Digito
        Case 163 ' Sinal de Libra
            TeclasPerm = Digito
        Case 168 ' Trema
            TeclasPerm = Digito
        Case 170 To 171
            TeclasPerm = Digito
        Case 180 ' Acento Agudo
            TeclasPerm = Digito
        Case 186 To 187
            TeclasPerm = Digito
    End Select
End If

' Proibidos
If Proibidos = True Then
    Select Case Digito
        Case 34 ' Aspas
            TeclasPerm = Digito
        Case 35 ' Sustenido
            TeclasPerm = Digito
        Case 39 ' Apóstrofo
            TeclasPerm = Digito
    End Select
End If

End Function

Private Sub Command1_Click()
'sql = "SELECT pedido.codigo_pedido, "
'sql = sql & "cadastrofarmacia.cnpj_farmacia, "
'sql = sql & "cadastrofarmacia.razao_social, "
'sql = sql & "cadastrodistribuidor.cnpj_distribuidor, "
'sql = sql & "cadastrodistribuidor.razao_social, "
'sql = sql & "Pedido.EQZ, "
'sql = sql & "cadastrovendedor.nome "
'sql = sql & "FROM brick INNER JOIN (cadastrovendedor "
'sql = sql & "INNER JOIN (cadastrodistribuidor "
'sql = sql & "INNER JOIN (cadastrofarmacia "
'sql = sql & "INNER JOIN pedido "
'sql = sql & "ON cadastrofarmacia.codigo_farmacia = pedido.codigo_farmacia) "
'sql = sql & "ON cadastrodistribuidor.codigo_distribuidor = pedido.codigo_distribuidor) "
'sql = sql & "ON cadastrovendedor.codigo_vendedor = pedido.codigo_vendedor) "
'sql = sql & "ON (cadastrovendedor.codigo_vendedor = brick.codigo_vendedor) "
'sql = sql & "AND (brick.eqz = pedido.eqz) "
'sql = sql & "AND (brick.eqz = cadastrofarmacia.eqz) "
'sql = sql & "WHERE (((pedido.codigo_pedido)=11))"
End Sub

Private Sub cbobrick_Click()

sql = "SELECT cadastrovendedor.nome, "
sql = sql & "cadastrovendedor.codigo_vendedor "
sql = sql & "FROM cadastrovendedor "
sql = sql & "INNER JOIN brick "
sql = sql & "ON cadastrovendedor.codigo_vendedor = brick.codigo_vendedor "
sql = sql & "WHERE brick.eqz = " & cbobrick.Text & ""
       
        Set rs = db.OpenRecordset(sql)
       'MsgBox sql
        If Not (rs.BOF And rs.EOF) Then
            rs.MoveMin
            txtvendedor.Text = IIf(IsNull(rs("nome")), "", rs("nome"))
            txtcodigovendedor.Text = IIf(IsNull(rs("codigo_vendedor")), "", rs("codigo_vendedor"))
        Else
            txtvendedor.Text = ""
            txtcodigovendedor.Text = ""
        End If
        rs.Close


End Sub

Private Sub cbovendedor_Click()

   sql = "Select codigo_vendedor from cadastrovendedor where nome = '" & cbovendedor.Text & "'"
      
        Set rs = db.OpenRecordset(sql)
        If Not (rs.BOF And rs.EOF) Then
            rs.MoveMin
            txtcodigovendedor.Text = IIf(IsNull(rs("codigo_vendedor")), "", rs("codigo_vendedor"))
        Else
            txtcodigovendedor.Text = ""
        End If
        rs.Close

End Sub

Private Sub cmdfarmaterr_Click()
    frmconsultafarmaterr.Show
End Sub

Private Sub cmdOk_Click()

        Dim Cancel As String
        If optcancelar.Value = True Then
            Cancel = "Cancelado"
        Else
            Cancel = ""
        End If

    Dim confirmar As Integer
                     
    confirmar = MsgBox("Confirma o Cancelamento", vbQuestion + vbYesNo, "Confirmação")
 
    If confirmar = 6 Then
       
    sql = "Update pedido set cancelado = '" & Cancel & "', obs2 = '" & txtobsalt.Text & "' where codigo_pedido = " & txtcodigo.Text & ""
   
    ' MsgBox sql
    ' Open App.Path & "SQL.txt" For Output As #1
    ' Print #1, sql
    ' Close #1

    db.Execute (sql)
    MsgBox ("Pedido Cancelado")
   
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 13
        SendKeys ("{TAB}")
        KeyAscii = 0
    End Select
End Sub


' ********************************************************
' ** CONFIGURA O CAMPO DE ACORDO COM A FUNÇÃO TECLASPERM**
' ********************************************************
Private Sub txtcodigo_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, True, False, False, False, False)
End Sub
Private Sub txtcodvendedor_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, True, True, False, False, True)
End Sub
Private Sub txtcodcliente_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, True, False, False, False, True)
End Sub
Private Sub txtcnpjfarmacia_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, True, False, False, False, False)
End Sub
Private Sub txtqtdetotal_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)
End Sub
Private Sub txtpreco_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)
End Sub
Private Sub txtvlrbruto_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)
End Sub
Private Sub txtvlrdesctotal_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)
End Sub
Private Sub txtvlrliq_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)
End Sub
Private Sub txtcancelado_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, False, False, False, False, True)
End Sub
Private Sub txtvendedor_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)
End Sub
Private Sub txtvd_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, False, False, False, False, True)
End Sub
Private Sub txtapontador_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, True, True, False, False, True)
End Sub
Private Sub txtprazo_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, True, True, False, False, False)
End Sub
Private Sub txtdesconto_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, True, True, False, False, True)
End Sub
Private Sub txtdata_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, False, True, False, False, False, False)
End Sub
Private Sub txtcliente_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, False, True, False, False, True)
End Sub
Private Sub txtaprovacaopedido_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, False, True, False, False, True)
End Sub
Private Sub txtcd_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, False, False, False, False, True)
End Sub
Private Sub txtobsalt_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, True, True, True, True, True)
End Sub
Private Sub txtobs_KeyPress(KeyAscii As Integer)
    KeyAscii = TeclasPerm(KeyAscii, True, True, True, True, True, True)
End Sub

' *****************************************************************************
' **AO CLICAR O NO CAMPO CODIGO DO VENDEDOR, APARECE A MENSAGEM DESCRITA ABAIXO**
' *****************************************************************************
Private Sub txtcodvendedor_Click()
    MsgBox "ATENÇÃO, VERIFICAR SEMPRE O CÓDIGO DO PEDIDO DO VENDEDOR"
End Sub
Private Sub txtcodvendedor_GotFocus()
    MsgBox "ATENÇÃO, VERIFICAR SEMPRE O CÓDIGO DO PEDIDO DO VENDEDOR"
End Sub

' *****************************************************************************
' **AO CLICAR O NO CAMPO DATA DO PEDIDO, APARECE A MENSAGEM DESCRITA ABAIXO****
' *****************************************************************************
Private Sub txtdata_GotFocus()
    MsgBox "ATENÇÃO O CAMPO DATA DA VENDA TÊM QUE SER EXEMPLO: 01012004, DE ACORDO COM O PEDIDO E SEMPRE 8 DIGITOS"
End Sub

' *********************************************************************
' *****BOTÃO PARA ALTERAR OS DADOS*************************************
' *********************************************************************
Private Sub cmdalterar_Click()
   
    Dim confirmar As Integer
                     
    confirmar = MsgBox("Confirma a Alteração", vbQuestion + vbYesNo, "Confirmação")
 
    If confirmar = 6 Then
   
    sql = "Update pedido set cancelado = '" & txtcancelado.Text & "', cod_pedido_vendedor = '" & txtcodvendedor.Text & "', cod_cliente_dist = '" & txtcodcliente.Text & "', codigo_distribuidor = '" & cbodist.Text & "', codigo_farmacia = '" & txtcnpjfarmacia.Text & "', eqz = '" & cbobrick.Text & "', codigo_vendedor = '" & cbovendedor.Text & "', apontador = '" & txtapontador.Text & "', prazo = '" & txtprazo.Text & "', tipo_cd = '" & txtcd.Text & "', desconto = '" & txtdesconto.Text & "', cliente = '" & txtcliente.Text & "', aprovacao = '" & txtaprovacaopedido.Text & "', obs = '" & txtobs.Text & "', qtde = " & txtqtdetotal.Text & ", valor_total = '" & lblprecototalpedido.Caption & "', obs2 = '" & txtobsalt.Text & "' where codigo_pedido = " & txtcodigo.Text & ""
    db.Execute (sql)
    MsgBox ("Alteração OK")
   
    sql2 = " "
   
    End If

End Sub

' *********************************************************************
' *****BOTÃO PARA LIMPAR OS CAMPOS DOS ITENS DO PEDIDO*****************
' *********************************************************************
Private Sub cmdcancelar2_Click()

If cmdincluir.Enabled = False Then
   cmdincluir.Enabled = True
End If

lstcodigopedido.Clear
lstqtdepedido.Clear
lstpreco.Clear
lstdesc.Clear
lstvlrbruto.Clear
lstvlrdesctotal.Clear
lstvlrliq.Clear

'lblprecototalpedido.Caption = ""

txtqtdetotal.Text = ""
txtpreco.Text = ""
'txtdesctotal.Text = ""
txtvlrbruto.Text = ""
txtvlrdesctotal.Text = ""
txtvlrliq.Text = ""

End Sub

' *****************************************************************************
' *****AO SELECIONAR O CODIGO DA DISTRIBUIDORA APARECE A RAZÃO SOCIAL AO LADO**
' *****************************************************************************
Private Sub cbodist_Click()

    sql = "Select codigo_distribuidor from cadastrodistribuidor where razao_social = '" & cbodist.Text & "'"
      
        Set rs = db.OpenRecordset(sql)
        If Not (rs.BOF And rs.EOF) Then
            rs.MoveMin
            txtcodigodistribuidor.Text = IIf(IsNull(rs("codigo_distribuidor")), "", rs("codigo_distribuidor"))
            'lbldistribuidora = IIf(IsNull(rs("razao_social")), "", rs("razao_social"))
        Else
            'lbldistribuidora = ""
            txtcodigodistribuidor.Text = ""
        End If
        rs.Close
       
End Sub

' *********************************************************************
' *****BOTÃO PARA CONSULTAR OS DADOS DO PEDIDO*************************
' *********************************************************************
Private Sub cmdconsultar_Click()
Dim n As Integer
'Dim sql1 As Integer
sql = "SELECT pedido.codigo_pedido, "
sql = sql & "pedido.cancelado, "
sql = sql & "Pedido.cod_pedido_vendedor , "
sql = sql & "Pedido.cod_cliente_dist, "
sql = sql & "cadastrodistribuidor.cnpj_distribuidor, "
sql = sql & "cadastrodistribuidor.razao_social as nome_distribuidor, "
sql = sql & "cadastrofarmacia.cnpj_farmacia, "
sql = sql & "cadastrofarmacia.razao_social, "
sql = sql & "cadastrofarmacia.eqz, "
sql = sql & "Brick.eqz, cadastrovendedor.nome, "
sql = sql & "cadastrofarmacia.eqz, "
sql = sql & "Pedido.apontador, Pedido.prazo, "
sql = sql & "Pedido.tipo_cd, "
sql = sql & "Pedido.eqz as eqz2, "
sql = sql & "Pedido.cliente, "
sql = sql & "Pedido.aprovacao, Pedido.obs, "
sql = sql & "Pedido.qtde, Pedido.valor_total, "
sql = sql & "Pedido.valor_bruto, "
sql = sql & "Pedido.valor_desconto_total, "
sql = sql & "Pedido.valor_liquido, "
sql = sql & "Pedido.obs2, "
sql = sql & "Pedido.Data2, itens_pedido2.codigo_produto, "
sql = sql & "itens_pedido2.desconto as descontoi, "
sql = sql & "itens_pedido2.qtde as qtdei, "
sql = sql & "itens_pedido2.Valor, "
sql = sql & "itens_pedido2.valor_bruto_i, "
sql = sql & "itens_pedido2.valor_desconto_total_i, "
sql = sql & "itens_pedido2.valor_liquido_i "
sql = sql & "FROM (cadastrovendedor "
sql = sql & "INNER JOIN (cadastrodistribuidor "
sql = sql & "INNER JOIN ((brick "
sql = sql & "INNER JOIN cadastrofarmacia "
sql = sql & "ON brick.eqz = cadastrofarmacia.eqz) "
sql = sql & "INNER JOIN pedido "
sql = sql & "ON (cadastrofarmacia.codigo_farmacia = pedido.codigo_farmacia) "
sql = sql & "AND (brick.eqz = pedido.eqz)) "
sql = sql & "ON cadastrodistribuidor.codigo_distribuidor = pedido.codigo_distribuidor) "
sql = sql & "ON (cadastrovendedor.codigo_vendedor = pedido.codigo_vendedor) "
sql = sql & "AND (cadastrovendedor.codigo_vendedor = brick.codigo_vendedor)) "
sql = sql & "INNER JOIN itens_pedido2 "
sql = sql & "ON pedido.codigo_pedido = itens_pedido2.codigo_pedido "
sql = sql & "WHERE (((pedido.codigo_pedido)= " & txtcodigo.Text & "))"
'    MsgBox sql
'    Open App.Path & "SQL.txt" For Output As #1
'    Print #1, sql
'    Close #1
     
Set rs = db.OpenRecordset(sql)
        If rs.EOF Then
            MsgBox "Pedido Invalido"
        Else
            If rs("cancelado") = "Cancelado" Then
            optcancelar.Value = True
            Else
            optcancelar.Value = False
            End If
            txtcodvendedor.Text = IIf(IsNull(rs("cod_pedido_vendedor")), "", rs("cod_pedido_vendedor"))
            txtcodcliente.Text = IIf(IsNull(rs("cod_cliente_dist")), "", rs("cod_cliente_dist"))
            cbodist.Text = IIf(IsNull(rs("nome_distribuidor")), "", rs("nome_distribuidor"))
            'lbldistribuidora = IIf(IsNull(rs("nome_distribuidor")), "", rs("nome_distribuidor"))
            txtcnpjfarmacia.Text = IIf(IsNull(rs("cnpj_farmacia")), "", rs("cnpj_farmacia"))
            'txtbrick.Text = IIf(IsNull(rs("eqz2")), "", rs("eqz2"))
            cbobrick.Text = IIf(IsNull(rs("eqz2")), "", rs("eqz2"))
            'cbobrick.AddItem rs!EQZ
            lblfarmacia = IIf(IsNull(rs("razao_social")), "", rs("razao_social"))
            txtvendedor.Text = IIf(IsNull(rs("nome")), "", rs("nome"))
            txtapontador.Text = IIf(IsNull(rs("apontador")), "", rs("apontador"))
            txtprazo.Text = IIf(IsNull(rs("prazo")), "", rs("prazo"))
            txtcd.Text = IIf(IsNull(rs("tipo_cd")), "", rs("tipo_cd"))
            'txtdata.Text = IIf(IsNull(rs("data")), "", rs("data"))
            txtcliente.Text = IIf(IsNull(rs("cliente")), "", rs("cliente"))
            txtaprovacaopedido.Text = IIf(IsNull(rs("aprovacao")), "", rs("aprovacao"))
            txtobs.Text = IIf(IsNull(rs("obs")), "", rs("obs"))
            txtqtdetotal.Text = IIf(IsNull(rs("qtde")), "", rs("qtde"))
            txtpreco.Text = IIf(IsNull(rs("valor_total")), "", rs("valor_total"))
            txtvlrbruto.Text = IIf(IsNull(rs("valor_bruto")), "", rs("valor_bruto"))
            txtvlrdesctotal.Text = IIf(IsNull(rs("valor_desconto_total")), "", rs("valor_desconto_total"))
            txtvlrliq.Text = IIf(IsNull(rs("valor_liquido")), "", rs("valor_liquido"))
            txtobsalt.Text = IIf(IsNull(rs("obs2")), "", rs("obs2"))
            lbldata2 = IIf(IsNull(rs("data2")), "", rs("data2"))
         Do While rs.EOF = False
            lstcodigopedido.AddItem rs!codigo_produto
            lstdesc.AddItem rs!descontoi
            lstqtdepedido.AddItem rs!qtdei
            lstpreco.AddItem rs!Valor
            lstvlrbruto.AddItem rs!valor_bruto_i
            lstvlrdesctotal.AddItem rs!valor_desconto_total_i
            lstvlrliq.AddItem rs!valor_liquido_i
            rs.MoveNext
            Loop
        End If
        For n = 0 To cbobrick.ListCount - 1
            Do While rs.EOF = False
                cbobrick.AddItem rs("eqz")
                rs.MoveNext
            Loop
            Exit For
         Next
      
            rs.Close
End Sub

' ******************************************************************************************************************************
' *****AO DIGITAR O CNPJ DA FARMÁCIA E CLICAR EM CONSULTAR APARECE A RAZÃO SOCIAL OU MENSAGEM SE NÃO EXISTIR NO BCO DE DADOS****
' ******************************************************************************************************************************
Private Sub cmdconsultar2_Click()
      
    sql = " Select codigo_farmacia, razao_social from cadastrofarmacia where cnpj_farmacia = '" & txtcnpjfarmacia & "'"
    Set rs = db.OpenRecordset(sql)
    If rs.EOF Then
        MsgBox "CNPJ Invalido"
    Else
        txtcodigofarmacia.Text = IIf(IsNull(rs("codigo_farmacia")), "", rs("codigo_farmacia"))
        lblfarmacia = IIf(IsNull(rs("razao_social")), "", rs("razao_social"))
    End If
    rs.Close
   
End Sub

' ************************************************************************************
' *****BOTÃO PARA ABRIR O FORMULÁRIO DE CODIGO DE VENDEDOR(ULTIMA VENDA DO VENDEDOR)**
' ************************************************************************************
Private Sub cmdconsultvend_Click()
    frmconsultacodpedidovend.Show
End Sub

' *********************************************************************
' *****BOTÃO PARA EXCLUIR OS DADOS ITENS DO PEDIDO*********************
' *********************************************************************
Private Sub cmdexcluir2_Click()
   
    Dim confirmar As Integer
                     
    confirmar = MsgBox("Confirma a Exclusão", vbQuestion + vbYesNo, "Confirmação")
 
    If confirmar = 6 Then
   
    Dim item As Integer
   
    item = lstcodigopedido.ListIndex
   
    lstcodigopedido.RemoveItem (item)
    lstqtdepedido.RemoveItem (item)
    lstpreco.RemoveItem (item)
    lstdesc.RemoveItem (item)
    lstvlrbruto.RemoveItem (item)
    lstvlrdesctotal.RemoveItem (item)
    lstvlrliq.RemoveItem (item)
     
    Dim qtdtotal As Integer
       
    For i = 0 To (lstqtdepedido.ListCount - 1)
    lstqtdepedido.ListIndex = i
    qtdtotal = qtdtotal + CInt(lstqtdepedido.Text)
    Next
       
    txtqtdetotal.Text = qtdtotal
       
   
    Dim ValorTotal As Currency
   
    For i = 0 To (lstpreco.ListCount - 1)
    lstpreco.ListIndex = i
    ValorTotal = ValorTotal + CCur(lstpreco.Text)
    Next
   
    txtpreco.Text = ValorTotal
   
    Dim ValorBruto As Currency
   
    For i = 0 To (lstvlrbruto.ListCount - 1)
    lstvlrbruto.ListIndex = i
    ValorBruto = ValorBruto + CCur(lstvlrbruto.Text)
    Next
   
    txtvlrbruto.Text = ValorBruto
  
   
    Dim ValorDescTotal As Currency
   
    For i = 0 To (lstvlrdesctotal.ListCount - 1)
    lstvlrdesctotal.ListIndex = i
    ValorDescTotal = ValorDescTotal + CCur(lstvlrdesctotal.Text)
    Next
   
    txtvlrdesctotal.Text = ValorDescTotal
   
   
    Dim ValorTotalLiq As Currency
   
    For i = 0 To (lstvlrliq.ListCount - 1)
    lstvlrliq.ListIndex = i
    ValorTotalLiq = ValorTotalLiq + CCur(lstvlrliq.Text)
    Next
   
    txtvlrliq.Text = ValorTotalLiq
   
   
    'Dim Desc As Currency
        
    'txtdesctotal.Text = Dados_Produto_Incluir.txtdesctotal.Text
   
    'Desc = Dados_Produto_Incluir.txtdesctotal.Text / 100
   
    'Dim vl As Single
    'If txtpreco.Text = "" Then txtpreco.Text = "0"
    'If Dados_Produto_Incluir.txtdesctotal.Text = "" Then Dados_Produto_Incluir.txtdesctotal.Text = "00,00"
    'vl = ((txtpreco.Text * Desc) - txtpreco.Text) * 0.82 * -1
   
    'lblprecototalpedido.Caption = vl
     
    End If
   
End Sub

' ************************************************************************************
' *****BOTÃO PARA ABRIR O FORMULÁRIO DE FARMÁCIAS CADASTRADAS POR TERRITÓRIO**********
' ************************************************************************************
Private Sub cmdfarma_Click()
'    frmconsultafarmaterritorio.Show
End Sub

' *********************************************************************
' ******************BOTÃO PARA INCLUIR O PEDIDO************************
' *********************************************************************
Private Sub cmdincluir_Click()
    
   ' MsgBox "ATENÇÃO O CAMPO DATA DA VENDA TÊM QUE SER EXEMPLO: 01012004, DE ACORDO COM O PEDIDO E SEMPRE 8 DIGITOS"
   
    'If txtdata.Text = "" Then
    '    MsgBox "CAMPO DATA DATA DA VENDA OBRIGATÓRIO, ATENÇÃO O CAMPO DATA DA VENDA TÊM QUE SER EXEMPLO: 01012004, DE ACORDO COM O PEDIDO E SEMPRE 8 DIGITOS"
    '    txtdata.SetFocus
    '    Exit Sub
    'End If
       
    Dim confirmar As Integer
                     
    confirmar = MsgBox("Confirma a Inclusão", vbQuestion + vbYesNo, "Confirmação")
 
    If confirmar = 6 Then
   
    Dim i           As Integer
    Dim cod         As Long
    Dim qry         As Recordset
   
    ' ***** REMOVIDA A ROTINA QUE BUSCAVA O ÚLTIMO CÓDIGO *****
    ' ***** E SOMAVA MAIS UM (1) PARA O PRÓXIMO CÓDIGO ********
       
    ' ***** INSERE O PEDIDO USANDO AUTO-NUMERAÇÃO *****
    sql = "Insert into pedido (cod_pedido_vendedor, "
    sql = sql & "cod_cliente_dist, "
    sql = sql & "codigo_distribuidor, "
    sql = sql & "codigo_farmacia, "
    sql = sql & "eqz, codigo_vendedor, "
    sql = sql & "apontador, prazo, tipo_cd, "
    sql = sql & "cliente, aprovacao, obs, "
    'sql = sql & "data, cliente, aprovacao, obs, "
    sql = sql & "qtde, valor_total, valor_bruto, "
    sql = sql & "valor_desconto_total, valor_liquido, obs2 "
    sql = sql & ") Values ("
    sql = sql & "'" & txtcodvendedor.Text & "','" & txtcodcliente.Text & "'," & txtcodigodistribuidor.Text & "," & txtcodigofarmacia.Text & "," & cbobrick.Text & "," & txtcodigovendedor.Text & ",'" & txtapontador.Text & "','" & txtprazo.Text & "','" & txtcd.Text & "','" & txtcliente.Text & "','" & txtaprovacaopedido.Text & "','" & txtobs.Text & "'," & txtqtdetotal.Text & ",'" & txtpreco.Text & "','" & txtvlrbruto.Text & "','" & txtvlrdesctotal.Text & "','" & txtvlrliq.Text & "','" & txtobsalt.Text & "')"
     'MsgBox sql
     'Open App.Path & "SQL.txt" For Output As #1
     'Print #1, sql
     'Close #1
   
    db.Execute (sql)
   
    ' ***** BUSCA O ÚLTIMO REGISTRO QUE FOI INSERIDO *****
    sql = "Select codigo_pedido From pedido Where"
    sql = sql & " data2 = #" & Month(Date) & "/" & Day(Date) & "/" & Year(Date) & "#"
    sql = sql & " And qtde = " & txtqtdetotal.Text
    sql = sql & " And codigo_distribuidor = " & txtcodigodistribuidor.Text & ""
    sql = sql & " And codigo_farmacia = " & txtcodigofarmacia.Text & ""
    sql = sql & " And codigo_vendedor = " & txtcodigovendedor.Text & ""
    sql = sql & " Order By codigo_pedido Desc"
    ' MsgBox sql
    ' Open App.Path & "SQL.txt" For Output As #1
    ' Print #1, sql
    ' Close #1
    Set rs = db.OpenRecordset(sql)
    If Not (rs.BOF And rs.EOF) Then
        cod = rs("codigo_pedido")
        'MsgBox cod
    End If
    rs.Close
  
    ' ***** INSERE OS ITENS DO PEDIDO *****
    For i = 0 To (lstcodigopedido.ListCount - 1)
       sql = "Insert into itens_pedido2(codigo_pedido, codigo_produto, qtde, valor, desconto, valor_bruto_i, valor_desconto_total_i, valor_liquido_i) Values(" & cod & "," & lstcodigopedido.List(i) & "," & lstqtdepedido.List(i) & ",'" & lstpreco.List(i) & "','" & lstdesc.List(i) & "','" & lstvlrbruto.List(i) & "','" & lstvlrdesctotal.List(i) & "','" & lstvlrliq.List(i) & "')"
       'MsgBox sql
       db.Execute (sql)
    Next i
   
    On Error Resume Next
    txtcodigo.Text = CStr(cod)
    'cmdincluir.Enabled = False
    MsgBox ("Inclusão OK para o Pedido Nº " & CStr(cod) & ".")
    End If

    txtcodigo.Text = ""
    optcancelar.Value = False
    txtcodvendedor.Text = ""
    txtcodcliente.Text = ""
    cbodist = ""
    lbldistribuidora = ""
    txtcnpjfarmacia.Text = ""
    lblfarmacia = ""
    'cbobrick.ListIndex = -1
    cbobrick.Text = ""
    txtvendedor.Text = ""
    txtcodigovendedor.Text = ""
    txtapontador.Text = ""
    txtcd.Text = ""
    txtprazo.Text = ""
    txtvlrbruto.Text = ""
    txtvlrdesctotal.Text = ""
    txtvlrliq.Text = ""
    txtdata.Text = ""
    txtcliente.Text = ""
    txtaprovacaopedido.Text = ""
    lstcodigopedido.Clear
    lstpreco.Clear
    lstdesc.Clear
    lstvlrbruto.Clear
    lstvlrdesctotal.Clear
    lstvlrliq.Clear
    lstqtdepedido.Clear
    txtqtdetotal.Text = ""
    lblprecototalpedido = ""
    txtpreco.Text = ""
    txtvlrbruto.Text = ""
    txtvlrdesctotal.Text = ""
    txtvlrliq.Text = ""
    lbldata2 = ""
    txtobsalt.Text = ""
    txtobs.Text = ""
    txtcodvendedor.SetFocus
   
End Sub

' *********************************************************************
' **************BOTÃO PARA INCLUIR OS ITENS DO PEDIDO******************
' *********************************************************************
Private Sub cmdincluir2_Click()
    Dados_Produto_Incluir.Show
End Sub

' *********************************************************************
' *****BOTÃO PARA LIMPAR OS CAMPOS*************************************
' *********************************************************************
Private Sub cmdlimpar_Click()
   
    txtcodigo.Text = ""
    optcancelar.Value = False
    txtcodvendedor.Text = ""
    txtcodcliente.Text = ""
    cbodist = ""
    lbldistribuidora = ""
    txtcnpjfarmacia.Text = ""
    lblfarmacia = ""
    cbobrick.Text = ""
    'cbobrick.ListIndex = -1
    txtvendedor.Text = ""
    txtcodigovendedor.Text = ""
    txtapontador.Text = ""
    txtcd.Text = ""
    txtprazo.Text = ""
    txtvlrbruto.Text = ""
    txtvlrdesctotal.Text = ""
    txtvlrliq.Text = ""
    'txtdata.Text = ""
    txtcliente.Text = ""
    txtaprovacaopedido.Text = ""
    lstqtdepedido.Text = ""
    txtqtdetotal.Text = ""
    lblprecototalpedido = ""
    lbldata2 = ""
    txtobsalt.Text = ""
    txtobs.Text = ""
    txtcodigo.SetFocus
End Sub

' *********************************************************************
' *****BOTÃO PARA CONSULTAR TODOS OS REGISTROS INCLUSOS****************
' *********************************************************************
Private Sub cmdtodos_Click()

    'ABRE FORMULÁRIO DE CONSULTA GERAL
    frmconsultageral.Show
   
    'ESCOLHE AUTOMATICAMENTE A TABELA A SER CONSULTADA
    frmconsultageral.optpedido.Value = True
   
    frmconsultageral.optpedido.SetFocus
       
    If frmconsultageral.optpedido.Value = True Then
    frmconsultageral.optvendedor.Value = False
    End If
       
    'BOTÃO PARA PESQUISAR
    frmconsultageral.cmdpesquisar = True

End Sub

' *****************************************************************************
' **CONFIGURA O FORMULÁRIO PARA PUXAR BCO DE DADOS E OUTROS********************
' *****************************************************************************
Private Sub Form_Load()
    Set ws = DBEngine.Workspaces(0)
    'sql = "\ServidorarquivosDESENVOLVIMENTOSistema de VendasEstrutura_SheringSistema Schering_18020510.2.200.2SPSOFTMETTASistema_Metta_Shering.mdb"
    sql = App.Path & "Sistema_Metta_Shering.mdb"
    Set db = ws.OpenDatabase(sql)
 
       'CARREGA O COMBO COM OS CODIGOS DE TERRITÓRIOS(TABELA BRICK)
       sql = "Select * from brick"
       Set rs = db.OpenRecordset(sql)
       Do While Not rs.EOF
           cbobrick.AddItem rs("eqz")
           rs.MoveNext
       Loop
       rs.Close
   
       'CARREGA O COMBO COM AS DISTRIBUIDORAS
        sql = "Select * from cadastrodistribuidor"
        Set rs = db.OpenRecordset(sql)
        Do While Not rs.EOF
            cbodist.AddItem rs("razao_social")
            cbodist.ItemData(cbodist.NewIndex) = rs("codigo_distribuidor")
            rs.MoveNext
        Loop
        rs.Close
       
        'CARREGA O COMBO COM OS Vendedores
        'sql = "Select * from cadastrovendedor"
        'Set rs = db.OpenRecordset(sql)
        'Do While Not rs.EOF
        '    cbovendedor.AddItem rs("nome")
        '    cbovendedor.ItemData(cbovendedor.NewIndex) = rs("codigo_vendedor")
        '    rs.MoveNext
        'Loop
        'rs.Close
       
       
End Sub

' *********************************************************************
' *****BOTÃO PARA SAIR DO FORMULÁRIO***********************************
' *********************************************************************
Private Sub cmdsair_Click()
    Unload Me
End Sub


deêm uma olhada.
e me ajudem, por favor.

obrigado

 

Rafael Carlos Martin
Desenvolvedor de WebSites e Sitemas
E-mail:rafa-martin@ibest.com.br
     
Rochª
Pontos: 2843 Pontos: 2843 Pontos: 2843
RIO DE JANEIRO
RJ - BRASIL
Postada em 17/02/2005 17:32 hs            
Tente colocar a barra antes do nome do arquivo.
 
sql = App.Path & "Sistema_Metta_Shering.mdb"
 

__________________________________________________________________________
Qualquer coisa post
 
Emoções
Rochª
     
Rafael The Best
SÃO PAULO
SP - BRASIL
Postada em 18/02/2005 08:52 hs            
já coloquei a barra e continua dando o mesmo erro.
 
fiz dessa maneira:
sql = App.Path & "Sistema_Metta_Shering.mdb"

Rafael Carlos Martin
Desenvolvedor de WebSites e Sitemas
E-mail:rafa-martin@ibest.com.br
     
Snake
Pontos: 2843
ITAJUBÁ
MG - BRASIL
Postada em 18/02/2005 09:39 hs         
Rafael,
Pq não declara o caminho em um modulo com publico?
- Eu faço assim
    Dim Caminho As String
    Caminho = "BancoDadosMeuBanco.mdb"
    Set Banco = DBEngine.Workspaces(0).OpenDatabase(App.Path & Caminho)
- Vc faz assim
    Set ws = DBEngine.Workspaces(0)
    SQL = App.Path & "Sistema_Metta_Shering.mdb" ' Pra mim o erro esta nesta linha !!!!! Tente fazer como mostrei acima.
    Set db = ws.OpenDatabase(SQL)

sem mais,
     
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2025   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página