Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

rafa-martin

caminho bando de dados

Por , em Visual Basic

Recommended Posts

rafa-martin    2

rafa-martin
Postado

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 linhaporque?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 IntegerDim sql As StringDim sql2 As StringDim db As DatabaseDim ws As WorkspaceDim 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 NextEnd 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 HabilitadoSelect Case Digito Case 8 ' BackSpace TeclasPerm = DigitoEnd Select' CTRL+C (Copiar) - Sempre HabilitadoSelect Case Digito Case 3 ' CTRL+C TeclasPerm = DigitoEnd Select' CTRL+X (Recortar) - Sempre HabilitadoSelect Case Digito Case 24 ' CTRL+X TeclasPerm = DigitoEnd Select' CTRL+V (Colar) - Sempre HabilitadoSelect Case Digito Case 22 ' CTRL+V TeclasPerm = DigitoEnd Select' LetrasIf 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 SelectEnd If' NumerosIf Numeros = True Then Select Case Digito Case 48 To 57 ' De 0 a 9 TeclasPerm = Digito End SelectEnd If' AuxiliaresIf 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 SelectEnd If' EspeciaisIf 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 SelectEnd If' ProibidosIf Proibidos = True Then Select Case Digito Case 34 ' Aspas TeclasPerm = Digito Case 35 ' Sustenido TeclasPerm = Digito Case 39 ' Apóstrofo TeclasPerm = Digito End SelectEnd IfEnd FunctionPrivate 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 SubPrivate 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.MoveFirst 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.CloseEnd SubPrivate 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.MoveFirst txtcodigovendedor.Text = IIf(IsNull(rs("codigo_vendedor")), "", rs("codigo_vendedor")) Else txtcodigovendedor.Text = "" End If rs.CloseEnd SubPrivate Sub cmdfarmaterr_Click() frmconsultafarmaterr.ShowEnd SubPrivate 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 IfEnd SubPrivate Sub Form_KeyPress(KeyAscii As Integer) Select Case KeyAscii Case 13 SendKeys ("{TAB}") KeyAscii = 0 End SelectEnd 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 SubPrivate Sub txtcodvendedor_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, True, True, False, False, True)End SubPrivate Sub txtcodcliente_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, True, False, False, False, True)End SubPrivate Sub txtcnpjfarmacia_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, True, False, False, False, False)End SubPrivate Sub txtqtdetotal_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)End SubPrivate Sub txtpreco_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)End SubPrivate Sub txtvlrbruto_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)End SubPrivate Sub txtvlrdesctotal_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)End SubPrivate Sub txtvlrliq_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)End SubPrivate Sub txtcancelado_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, False, False, False, False, True)End SubPrivate Sub txtvendedor_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, False, False, False, False, False)End SubPrivate Sub txtvd_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, False, False, False, False, True)End SubPrivate Sub txtapontador_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, True, True, False, False, True)End SubPrivate Sub txtprazo_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, True, True, False, False, False)End SubPrivate Sub txtdesconto_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, True, True, False, False, True)End SubPrivate Sub txtdata_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, False, True, False, False, False, False)End SubPrivate Sub txtcliente_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, False, True, False, False, True)End SubPrivate Sub txtaprovacaopedido_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, False, True, False, False, True)End SubPrivate Sub txtcd_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, False, False, False, False, True)End SubPrivate Sub txtobsalt_KeyPress(KeyAscii As Integer) KeyAscii = TeclasPerm(KeyAscii, True, True, True, True, True, True)End SubPrivate 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 SubPrivate 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 IfEnd Sub' *********************************************************************' *****BOTÃO PARA LIMPAR OS CAMPOS DOS ITENS DO PEDIDO*****************' *********************************************************************Private Sub cmdcancelar2_Click()If cmdincluir.Enabled = False Then cmdincluir.Enabled = TrueEnd Iflstcodigopedido.Clearlstqtdepedido.Clearlstpreco.Clearlstdesc.Clearlstvlrbruto.Clearlstvlrdesctotal.Clearlstvlrliq.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.MoveFirst 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 Integersql = "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.CloseEnd 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.ShowEnd 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.ShowEnd 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.ShowEnd 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.SetFocusEnd 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 = TrueEnd Sub' *****************************************************************************' **CONFIGURA O FORMULÁRIO PARA PUXAR BCO DE DADOS E OUTROS********************' *****************************************************************************Private Sub Form_Load() Set ws = DBEngine.Workspaces(0) 'sql = "\\Servidor\arquivos\DESENVOLVIMENTO\Sistema de Vendas\Estrutura_Shering\Sistema Schering_180205\10.2.200.2\SP\SOFT\METTA\Sistema_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 MeEnd Subdeêm uma olhada.e me ajudem, por favor.obrigado

Compartilhar este post

Link para o post
Compartilhar em outros sites

Screech    0

Screech
Postado

Desta maneira você nunca conseguirá...por exemplo, se ele estiver em C:\Banco\Sistema_Metta_Shering.mdbentãosql = App.Path & "C:\Banco\Sistema_Metta_Shering.mdb"Mas...Se o banco estiver numa pasta filha, fica mais fácilSistema: C:\SistemaBanco: C:\Sistema\Banco\Sistema_Metta_Shering.mdbsql = App.Path & "\Banco\Sistema_Metta_Shering.mdbBeleza

Compartilhar este post

Link para o post
Compartilhar em outros sites

allan_pedroni    0

allan_pedroni
Postado

Olá amigo!

Analisei o seu código e percebi que você nem chegou a fazer a CONEXÂO COM O BANCO de dados direito!

 

Ao se atribuir um valor do tipo seguinte "app.path & \caminho+banco.mdb", tente verificar se existe o arquivo, caso contrário mate o programa "end" !

 

* Exemplo de conexão que você está querendo fazer 1° para depois fazer o restante!

 

Dim ws As DatabaseDim db As RecordsetDim caminho_banco as stringPrivate Sub Form_Load()caminho_banco = App.Path & "\Sistema_Metta_Shering.mdb"Set ws = DBEngine.Workspaces(0).OpenDatabase(caminho_banco)Set db = ws.OpenDatabase("tabela_que_voce_deseja",DbOpenTable)..'OBS: existem além de DbOpenTable as : DbOpenDynaset e DbOpenSnapshot.. ....

Amigo, tente resumir mais o seu código para que ele trabalhe mais rápido. Divida mais em módulos ou então, bole funções que diminuirão 100 linha a menos se for o caso!

 

Boa sorte com o código amigo!

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos Visual Basic
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito