ERRO AO INCLUIR REGISTRO 3251

Citação:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam

As Long, lParam As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As

String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Const CB_SETDROPPEDWIDTH = &H160

Private cnn As ADODB.Connection
Private rs As ADODB.Recordset
Private rs3 As ADODB.Recordset
Public proc As Integer

Dim UP, UP2
Dim c As Byte
Dim strtextoemail As String

Private Sub btnroteiro_Click()
enviaroteiro
End Sub

Private Sub cmdaeroporto_Click()
frmvoo.Show
End Sub

Private Sub cmdAlterar_Click()

rs.Find "codigo =" & codigo.Text, , , 1

If Not rs.EOF Then 'se encontrou


rs!codigo = codigo.Text
rs!codcliente = codcliente.Text
rs!empresa = empresa.Text
rs!sede = sede.Text
rs!dtsaida = trata_data(dtsaida.Text)
rs!Data = dtsaida.Text
rs!hrsaida = hrsaida.Text
rs!usuario = Text2.Text


'dados de operacao do sistema
Set rsM = cnn.Execute("select * from motorista where nome = '" & motorista.Text & "' ")


If (Not rsM.EOF) And (Not rsM.BOF) Then

sigla.Text = rsM!tipo

Else

sigla.Text = "0"

End If
rs!sigla = sigla.Text
rs!operador = rs!operador
rs!datacadastro = rs!datacadastro
rs!datalteracao = Now()
rs!alteradopor = UCase(StrUsuario)


If MsgBox("Deseja prosseguir com alteração?", vbYesNo) = vbYes Then

rs.Update

MsgBox "Dados Alterados com sucesso !", vbInformation, "Alteração"

Else

Limpacombos
LimpaTextos
geracodigo

End If

End If

End Sub


Private Sub cmdAnterior_Click()
cmdreenvia.Enabled = True

If rs.EOF = True And rs.BOF = True Then
MsgBox "A Tabela está Vazia!", vbExclamation, "Aviso!"
Exit Sub
End If

On Error GoTo Anterior1

rs.MovePrevious
Call mostradados3

Exit Sub
Anterior1:

If Err.Number = 3021 Then
MsgBox "Você já esta no Primeiro Registro!", vbInformation, "Aviso!!"
rs.MoveFirst

botoes

cmdlog.Enabled = True


Call mostradados3
Exit Sub
End If

End Sub


Private Sub cmdcancela_Click()
Limpacombos
LimpaTextos
geracodigo
cmdAlterar.Enabled = False
cmdAnterior.Enabled = True
cmdProximo.Enabled = True
cmdExcluir.Enabled = False
cmdSalvar.Enabled = False
cmdlog.Enabled = False
Temp = hrsaida.Mask
hrsaida.Mask = ""
hrsaida.Text = ""
hrsaida.Mask = Temp
zera
End Sub

Private Sub cmdemail_Click()
Frame5.Visible = False

End Sub

Private Sub cmderro_Click()

Frame6.Visible = False

End Sub

Private Sub cmdExcluir_Click()
rs.Find "codigo =" & codigo.Text, , , 1

If Not rs.EOF Then 'se encontrou
rs!codigo = codigo.Text
rs!Status = "False"
rs!cancepor = StrUsuario
rs!datacanc = Now()
If MsgBox("Deseja prosseguir com o cancelamento da Viagem?", vbYesNo) = vbYes Then

rs.Update

MsgBox "Viagem Cancelada !", vbInformation, "Alteração"
zera
Else


Limpacombos
LimpaTextos
geracodigo
zera
Exit Sub

End If
End If

End Sub

Private Sub cmdNovo_Click()
cmdreenvia.Enabled = False
cmdSalvar.Enabled = True
cmdAnterior.Enabled = False
cmdProximo.Enabled = False
usuario.Enabled = True
empresa.SetFocus
Limpacombos
LimpaTextos
listnext.Visible = False
Label43.Visible = False
cmdAlterar.Enabled = False
geracodigo 'gera um novo codigo do registro
Label29 = GerarCodigo
usuario.Clear
Temp = hrsaida.Mask
hrsaida.Mask = ""
hrsaida.Text = ""
hrsaida.Mask = Temp
zera
End Sub

Private Sub cmdprocuraresponsavel_Click()
frmbuscaconta.Show modal

End Sub

Private Sub cmdProximo_Click()
cmdreenvia.Enabled = True
If rs.EOF = True And rs.BOF = True Then
MsgBox "A Tabela está Vazia!", vbExclamation, "Aviso!"
Exit Sub
End If
On Error GoTo Proximo1

rs.MoveNext
Call mostradados3
cmdAlterar.Enabled = True


Exit Sub
Proximo1:
If Err.Number = 3021 Then
MsgBox "Você já esta no ÃÅ¡ltimo Registro!", vbInformation, "Aviso!!"
rs.MoveLast

botoes

Call mostradados3
Exit Sub

End If

End Sub

Private Sub cmdreenvia_Click()
reenvia
End Sub

Private Sub cmdSalvar_Click()

questiona

End Sub



Private Sub Image20_Click(Index As Integer)
Frame5.Visible = False
End Sub

Private Sub Command1_Click()
On Error GoTo errcalck

vlviagem.valor = calckm.Text * calc.valor

errcalck:
If Err = 13 Then
MsgBox "O valor do KM não pode estar em branco", vbInformation, "KM"
End If
Exit Sub
calckm.SetFocus
End Sub

Private Sub Command3_Click()
'********* criado em 05/04/2005
On Error GoTo errcalck
Dim ft As Double

If calckm.Text <= "99" Then
ft = "1,60"
vlviagem.valor = calckm.Text * ft
End If

errcalck:
If Err = 13 Then
MsgBox "O valor do KM não pode estar em branco", vbInformation, "KM"
End If
Exit Sub
calckm.SetFocus
End Sub

Private Sub Command4_Click()

Dim fator As String

Set Rst = cnn.Execute("select * from roteiro where roteiro = '" & roteiro.Text & "' ")
If (Not Rst.EOF) And (Not Rst.BOF) Then

fator = Rst!km

If Rst!km <= "99" Then

vlviagem.valor = Rst!vltotal

ElseIf Rst!km > "99" Or Rst!km = "0" Then

vlviagem.valor = Rst!valores

End If
End If

End Sub

Private Sub Command5_Click()
Text2.Visible = True
usuario.Visible = False

End Sub

Private Sub Command6_Click()

Frame6.Visible = False
cmdAlterar.Enabled = False
cmdSalvar.Enabled = False
cmdreenvia.Enabled = False
cmdExcluir.Enabled = True

End Sub


Private Sub Image1_Click(Index As Integer)
Frame1.Visible = False

End Sub

Private Sub Image11_DBLClick()
enviaroteiro
End Sub

Private Sub Image12_Click()
frmpesqccof.Show modal
frmpesqccof.Text2.Text = ccusto.Text
frmpesqccof.Text3.Text = depto.Text
frmpesqccof.Text4.Text = unidade.Text
frmpesqccof.Text5.Text = responsavel.Text
frmpesqccof.Text6.Text = emailsecretaria.Text
End Sub

Private Sub listnext_Click()
LimpaTextos
Limpacombos

If listnext.ListIndex = -1 Then

Text3.Text = ""

Exit Sub
End If

Set rs5 = cnn.Execute("Select * from agendamento where codigo ='" & listnext.ItemData(listnext.ListIndex) & "'")

Text3.Text = rs5("codigo")
End Sub

Private Sub listnext_DBLClick()

mostradadoslist

End Sub
Private Sub Listview1_Click()
LimpaTextos
Limpacombos

If Listview1.ListIndex = -1 Then

Text3.Text = ""

Exit Sub
End If

Set rs5 = cnn.Execute("Select * from agendamento where codigo ='" & Listview1.ItemData(Listview1.ListIndex) & "'")

Text3.Text = rs5("codigo")

End Sub
Private Sub Listview1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
'chama o evento DBLCLICK (DUPLO CLIQUE) do controle LIST1
Listview1_DBlClick
End If
End Sub
Private Sub Listnext_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
'chama o evento DBLCLICK (DUPLO CLIQUE) do controle LIST1
listnext_DBLClick
End If
End Sub
Private Sub Listview1_DBlClick()

mostradadoslist

End Sub

Private Sub retorno_Click()

cmdSalvar.Enabled = True

If retorno.Text = "Não" Then
hrretorno.Text = "00:00"
ElseIf retorno.Text = "Sim" Then

Temp = hrretorno.Mask
hrretorno.Mask = ""
hrretorno.Text = ""
hrretorno.Mask = Temp

End If

End Sub

Private Sub SMTP_CloseSMTP()
If SMTP.Status = "SMTP session closed" Then
lblstatus = "Viagem Enviada para" 'SMTP.Status
lblstatus2 = enviaemail.Text
Else
lblstatus = SMTP.Status
End If

End Sub

Private Sub SMTP_ConnectSMTP()

If SMTP.Status = "Authenticated" Then

lblstatus = "Autenticando....." 'SMTP.Status

Else
lblstatus = SMTP.Status
End If
End Sub

Private Sub SMTP_ErrorSMTP(ByVal Number As Integer, Description As String)
lblstatus = lblstatus & "Error " & Number & ": " & Description & vbCrLf
End Sub

Private Sub SMTP_SendSMTP()

If SMTP.Status = "Message sent" Then

lblstatus = "Enviando E-mail da Viagem para" 'SMTP.Status & vbCrLf
lblstatus2 = enviaemail.Text
Else
lblstatus = SMTP.Status & vbCrLf
End If

End Sub

Private Sub cmdlimpa_Click()
Limpacombos
LimpaTextos
geracodigo
Label32.Caption = ""
txtcep.Text = ""
cnpj.Text = ""
Temp = hrsaida.Mask
hrsaida.Mask = ""
hrsaida.Text = ""
hrsaida.Mask = Temp
End Sub

Private Sub empresa_Click()
sede.Clear
' preenche o combo de sede de acordo com o escolhido no combo empresas

Set rsS = cnn.Execute("select DISTINCT sede from empresas where empresa = '" & empresa.Text & "' ")

' sede.AddItem rsS!sede


' se retornou dados no recordset
If (Not rsS.EOF) And (Not rsS.BOF) Then
Do While Not rsS.EOF
' preenche o combo Banco Avisador

sede.AddItem rsS!sede

rsS.MoveNext
Loop

Else
sede.Text = "Não existe sede cadastrada"

End If

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
SendKeys "{Tab}"
KeyCode = 0
End If
End Sub

Private Sub Command2_Click()
frmpesquisa.Show
strcaptura = Text2.Text 'usuario.Text
usuario.Visible = True
Text2.Visible = False
Label43.Visible = False
listnext.Visible = False
End Sub

Private Sub Form_Load()
Me.WindowState = vbMaximized

SendMessage motorista.hwnd, CB_SETDROPPEDWIDTH, 300, 0
SendMessage empresa.hwnd, CB_SETDROPPEDWIDTH, 300, 0
SendMessage roteiro.hwnd, CB_SETDROPPEDWIDTH, 300, 0

conecta
geracodigo
ocorre

[txt-color=#ff0000] rs.Open "Select * from agendamento", cnn, adOpenKeyset, adLockOptimistic[/txt-color]

botoes

'preencher lista de sede

Set rsE = cnn.Execute("select DISTINCT empresa from empresas where tipo = 'C'")

sede.Clear

If (Not rsE.EOF) And (Not rsE.BOF) Then
Do While Not rsE.EOF
' preenche o combo Banco Avisador
empresa.AddItem rsE!empresa

rsE.MoveNext
Loop
End If

'popula combo motorista

' Set rsM = cnn.Execute("select DISTINCT nome from motorista")


' If (Not rsM.EOF) And (Not rsM.BOF) Then
' Do While Not rsM.EOF
' preenche o combo Banco Avisador
motorista.AddItem "Map Brasil"
motorista.AddItem "Francisco"
motorista.AddItem "Eugenio"
motorista.AddItem "Bat Taxi"

' rsM.MoveNext
'Loop
' End If

'recupera dados para envio de e-mail

Set rsmail = cnn.Execute("Select * from mailserver")

Label30.Visible = False
Label31.Visible = False

'atualiza dtpicker

MonthView1.Value = Date
MonthView2.Value = Date

' balao de ajuda

StartTip hwnd
CreateBalloon Picture1.hwnd, "Enviar E-mail solicitando cadastro de Roteiro"
CreateBalloon Command1.hwnd, "Calcular se o valor do KM for superior a 99"
CreateBalloon Command3.hwnd, "Calcular se o valor do KM for inferior a 100"
CreateBalloon listnext.hwnd, "Dê duplo click, ou enter para visualizar dados da viagem"
CreateBalloon Listview1.hwnd, "Dê duplo click ou enter para visualizar dados da viagem"
CreateBalloon cmdcalcroteiro.hwnd, "Calcula o valor estabelecido no roteiro"
CreateBalloon usuario.hwnd, "Dê dois cliques para busca dos dados ou tecle ENTER para remover um item da lista"

End Sub

Private Sub MonthView1_DateClick(ByVal DateClicked As Date)

dtsaida.Text = MonthView1.Value
Frame1.Visible = False
listnext.Clear
listseguinte

End Sub

Private Sub MonthView2_DateClick(ByVal DateClicked As Date)
diapre.Text = MonthView1.Value
Frame2(0).Visible = False
End Sub

Private Sub diapre_GotFocus()
Frame2(0).Visible = True
End Sub

Private Sub dtsaida_GotFocus()
Frame1.Visible = True
End Sub


Private Sub Limpacombos()
Dim CBL As Control

For Each CBL In Me.Controls

If TypeOf CBL Is ComboBox Then CBL.Text = Empty

Next
End Sub

Private Sub LimpaTextos()
Dim Ctl As Control
For Each Ctl In Me.Controls

If TypeOf Ctl Is TextBox Then Ctl.Text = Empty

Next
End Sub

Private Sub roteiro_Click()

Set Rst = cnn.Execute("select * from roteiro where roteiro = '" & roteiro.Text & "' ")
If (Not Rst.EOF) And (Not Rst.BOF) Then

' saida.Text = rsT!origem
' destino.Text = rsT!destino
calckm.Text = Rst!km

Else
' saida.Text = ""
' destino.Text = ""
vlviagem.valor = ""
End If


End Sub

Private Sub sede_Click()
roteiro.Clear

Set rs = cnn.Execute("select valorkm from empresas where tipo = 'C' and empresa = '" & empresa.Text & "' and sede = '" &

sede.Text & "'")

calc.valor = rs!valorkm



End Sub



Private Sub usaroteiro_Click()
If usaroteiro.Value = Unchecked Then
Label28.Visible = False
Label32.Visible = True
calckm.Visible = True
roteiro.Visible = False
Command1.Visible = True
Command3.Visible = True
cmdcalcroteiro.Visible = False



Else
Command1.Visible = False
Command3.Visible = False
cmdcalcroteiro.Visible = True
Label28.Visible = True
roteiro.Visible = True
Label32.Visible = False
calckm.Visible = False

mostraroteiro

End If

End Sub

Private Sub usuario_DBLClick()

If usuario.Text = "" Then

MsgBox ("Você deve digitar um usuario para busca")

Else

Set rs3 = cnn.Execute("Select * from usuarios where usuario = '" & usuario.Text & "'")


mostradados2

End If

Image3.Visible = True
Image4.Visible = True
Image5.Visible = True


End Sub


Public Sub mostradados3()

Dim statusns As Boolean
cmdAlterar.Enabled = True
'On Error GoTo Erro_alterar

statusns = rs!Status

If statusns = False Then

Frame6.Visible = True
Label46.Caption = rs!cancepor
Label48.Caption = rs!datacanc

Else
Frame6.Visible = False


codigo.Text = rs!codigo
codcliente.Text = IIf(IsNull(rs!codcliente), "", rs!codcliente)
empresa.Text = rs!empresa
sede.Text = rs!sede
dtsaida.Text = acerta_data(rs!dtsaida)
hrsaida.Text = rs!hrsaida
usuario.Text = IIf(IsNull(rs!guardausuario), "", rs!guardausuario)


If forma.Text = "Cartão" Then
optpag(0).Value = Checked
ElseIf forma.Text = "Cheque" Then
optpag(1).Value = Checked
ElseIf forma.Text = "Dinheiro" Then
optpag(2).Value = Checked
ElseIf forma.Text = "Conta" Then
optpag(3).Value = Checked
ElseIf forma.Text = "Cheque-Pre" Then
optpag(4).Value = Checked
ElseIf forma.Text = "Centro de Custo" Then
optpag(5).Value = Checked
ElseIf forma.Text = "Cortesia" Then
optpag(6).Value = Checked
End If

End If

End Sub


Private Function GerarCodigo()
Dim valores, i

'Inicia a função com valor em branco
GerarCodigo = ""

'Define um vetor com os elementos de nosso código
valores = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K",

"L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j",

"k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "x", "y", "z")
'valores = Array("animal","variam","alguem","saber","mapbr","teste","lutam","andar","fugiam","varriam")

Randomize
For i = 1 To 5
GerarCodigo = GerarCodigo & valores(Int(UBound(valores) * Rnd))
Next
End Function

Private Sub botoes()

If Stralteracao = "True" Then
cmdAlterar.Enabled = True
Else
cmdAlterar.Enabled = False

End If

If Strexclusao = "True" Then
cmdExcluir.Enabled = True

Else
cmdExcluir.Enabled = False
End If

If strInclusao = "True" Then

cmdSalvar.Enabled = True
Else
cmdSalvar.Enabled = False
End If
cmdlog.Enabled = True

End Sub


Private Function trata_data(expr)

Data = Split(expr, "/")
data_d = Data(0)
data_m = Data(1)
data_a = Data(2)
If Len(data_d) = 2 Then
diax = data_d
Else
'diax = "0" & data_d
diax = "" & data_d

End If

If Len(data_m) = 2 Then
mesx = data_m
Else
'mesx = "0" & data_m
mesx = "" & data_m

End If

If Len(data_a) = 2 Or Len(data_a) = 4 Then
anox = Right(data_a, 4)
Else
anox = "0" & data_a
End If

'data = diax & "/" & mesx & "/" & anox

Data = anox & "/" & mesx & "/" & diax

trata_data = Data

End Function


Private Function acerta_data(expr)

Data = Split(expr, "/")

data_a = Data(0)
data_m = Data(1)
data_d = Data(2)

If Len(data_d) = 2 Then
diax = data_d
Else
'diax = "0" & data_d
diax = "" & data_d

End If

If Len(data_m) = 2 Then
mesx = data_m
Else
'mesx = "0" & data_m
mesx = "" & data_m

End If

If Len(data_a) = 2 Or Len(data_a) = 4 Then
anox = Right(data_a, 4)
Else
anox = "0" & data_a
End If

Data = diax & "/" & mesx & "/" & anox

'Data = anox & "/" & mesx & "/" & diax

acerta_data = Data

End Function


Private Sub ocorre()
Dim hoje As String, hora As String, ver As String
hoje = Date
hora = Time
ver = trata_data(hoje)

Label45.Caption = hoje
Listview1.Clear
On Error GoTo errou2
Set rsA = cnn.Execute("Select * from agendamento where dtsaida = '" & ver & "' and hrsaida > '" & hora & "' and status =

'1' order by hrsaida ASC")


While Not rsA.EOF
' left(Nome1 & space(10), 10) & left(Sobrenome2 & space(20), 20)

Listview1.AddItem LSeta(rsA!codigo, 6, 2) & LSeta(rsA!hrsaida, 5, 2) & LSeta(rsA!usuario, 30, 3) &

LSeta(rsA!motorista, 20, 3) & rsA!mensagem
Listview1.ItemData(Listview1.NewIndex) = rsA("codigo")
rsA.MoveNext
Wend

errou2:

If Err = 3704 Then
MsgBox "Conexão com SQL SERVER fechada", vbInformation, "Conexão"
End If
Exit Sub

End Sub


Private Sub mostradadoslist()


Set rs5 = cnn.Execute("Select * from agendamento where codigo ='" & Text3.Text & "'")


codigo.Text = rs5!codigo
codcliente.Text = rs5!codcliente
empresa.Text = rs5!empresa
sede.Text = rs5!sede
dtsaida.Text = acerta_data(rs5!dtsaida)
hrsaida.Text = rs5!hrsaida
usuario.Text = rs5!guardausuario


If forma.Text = "Cartão" Then
optpag(0).Value = Checked
ElseIf forma.Text = "Cheque" Then
optpag(1).Value = Checked
ElseIf forma.Text = "Dinheiro" Then
optpag(2).Value = Checked
ElseIf forma.Text = "Conta" Then
optpag(3).Value = Checked
ElseIf forma.Text = "Cheque-Pre" Then
optpag(4).Value = Checked
ElseIf forma.Text = "Centro de Custo" Then
optpag(5).Value = Checked
ElseIf forma.Text = "Cortesia" Then
optpag(6).Value = Checked
End If

usuario.Clear

Do While Not rs5.EOF

usuario.AddItem rs5!usuario

rs5.MoveNext
Loop


End Sub

Private Sub listseguinte()

Dim hoje As String, hora As String, ver As String
hoje = Format$(MonthView1.Value, "yyyy/m/d")

Label43.Visible = True
Label43.Caption = "Viagens agendadas para o dia " & dtsaida.Text
listnext.Visible = True

Set rsB = cnn.Execute("Select * from agendamento where dtsaida = '" & hoje & "' and sede = '" & sede & "' order by

hrsaida ASC")


While Not rsB.EOF


listnext.AddItem LSeta(rsB!codigo, 6, 2) & LSeta(rsB!hrsaida, 5, 3) & LSeta(rsB!usuario, 30, 5) & LSeta(rsB!saida,

40, 5) & rsB!destino
listnext.ItemData(listnext.NewIndex) = rsB("codigo")


rsB.MoveNext
Wend

End Sub



Private Sub gravareenvia()

On Error GoTo Erro_alterar

rs.Find "codigo =" & codigo.Text, , , 1

If Not rs.EOF Then 'se encontrou


rs!codigo = codigo.Text
rs!codcliente = codcliente.Text
rs!empresa = empresa.Text
rs!sede = sede.Text
rs!dtsaida = trata_data(dtsaida.Text)
rs!Data = dtsaida.Text
rs!hrsaida = hrsaida.Text
rs!usuario = Text2.Text


'dados de operacao do sistema
Set rsM = cnn.Execute("select * from motorista where nome = '" & motorista.Text & "' ")


If (Not rsM.EOF) And (Not rsM.BOF) Then

sigla.Text = rsM!tipo

Else

sigla.Text = "0"

End If
rs!sigla = sigla.Text
rs!operador = rs!operador
rs!datacadastro = rs!datacadastro
rs!datalteracao = Now()
rs!alteradopor = UCase(StrUsuario)


If MsgBox("Deseja prosseguir com alteração?", vbYesNo) = vbYes Then

rs.Update

MsgBox "Dados Alterados com sucesso !", vbInformation, "Alteração"

Else

Limpacombos
LimpaTextos
geracodigo

End If

End If


Erro_alterar:

If Err = 3186 Then

MsgBox "Informação bloqueada e não gravada...", vbInformation

ElseIf Err = 3197 Then

MsgBox "Informação Recentemente alterada por outro usuário...", vbInformation

ElseIf Err = 3260 Then

MsgBox "Sistema não pode Atualizar Informação!", vbInformation

ElseIf Err = 3265 Then

MsgBox "Não foi possivel encontrar a NS" & vbCrLf & "Verifique se a mesma está cadastrada!"

ElseIf Err.Number = -2147467259 Then

MsgBox "Falha na Conexão com base SQL...", vbInformation, "[SQL SERVER]"

Else
MsgBox "Ocorreu o seguinte erro:" & Err & ":" & Error, 64, "Suporte"

End If
Exit Sub
End Sub


Private Sub conecta()
[txt-color=#00ff00] Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rs2 = New ADODB.Recordset


cnn.CursorLocation = adUseClient

cnn.Open "Provider=sqloledb;" & _
"Network Library=DBMSSOCN;" & _
"Data Source=127.0.0.1;" & _
"User ID=ID;" & _
"Password=senha"[/txt-color]
End Sub

Private Sub mostraroteiro()

Set Rst = cnn.Execute("select valorkm from empresas where tipo = 'C' and empresa = '" & empresa.Text & "' and sede = '" &

sede.Text & "'")

calc.valor = Rst!valorkm

Set rsR = cnn.Execute("select * from roteiro where origem2 = '" & sede.Text & "' ")

' sede.AddItem rsS!sede
' se retornou dados no recordset
If (Not rsR.EOF) And (Not rsR.BOF) Then
Do While Not rsR.EOF
' preenche o combo Banco Avisador

roteiro.AddItem rsR!roteiro

rsR.MoveNext
Loop
Else
roteiro.Text = "Não existe roteiro cadastrado"
End If

End Sub

Private Sub usuario_KeyPress(KeyAscii As Integer)
For intI = 0 To 0
usuario.RemoveItem 0
Next intI
End Sub

Public Sub resultado()

Set rs = cnn.Execute("Select * from agendamento where codigo= '" & proc & "'")

If Not rs.EOF Then

mostradados3
cmdAlterar.Visible = True


Else
MsgBox "NS não encontrada!", vbInformation, "Consulta"
End If


End Sub

Private Sub questiona()

gravando

End Sub


Private Sub gravando() ' [txt-color=#0000ff]AQUI DA O ERRO DE INCLUSAO[/txt-color]

Dim codenvia As String

rs.AddNew

rs!codcliente = codcliente.Text
rs!empresa = empresa.Text

rs!sede = sede.Text
rs!dtsaida = trata_data(dtsaida.Text)
rs!Data = dtsaida.Text
rs!hrsaida = hrsaida.Text
rs!usuario = Text2.Text
rs!telusuario = telusuario.Text
rs!saida = saida.Text
rs!destino = destino.Text
rs!ccusto = ccusto.Text
rs!depto = depto.Text
rs!unidade = unidade.Text


If MsgBox("Deseja Agendar esta viagem?", vbYesNo) = vbYes Then


Set rs2 = cnn.Execute("select codigo from agendamento where codigo = '" & codigo.Text & "'")

If rs2.EOF Then

rs!codigo = codigo.Text
rs.Update

Else

Set rs2 = cnn.Execute("select Max(codigo) as cod from agendamento")

contas = rs2("cod")

codigo.Text = contas + 1

rs!codigo = contas + 1

rs.Update

End If


str001 = (...)

strHTM = str001 & str002 & Str003 & Str004 & Str005 & Str006 & Str007 & Str008 & Str009

Text1.Text = strHTM

envia


Limpacombos
LimpaTextos

MsgBox "Agendamento efetuado com sucesso!", vbInformation, "Agendamento"


Text1.Text = strHTM
listnext.Visible = False
Listview1.Visible = True
Label43.Visible = False
Listview1.Refresh

Else

Limpacombos
LimpaTextos
geracodigo
ocorre
usuario.Clear


Temp = hrsaida.Mask
hrsaida.Mask = ""
hrsaida.Text = ""
hrsaida.Mask = Temp

Temp2 = hrretorno.Mask
hrretorno.Mask = ""
hrretorno.Text = ""
hrretorno.Mask = Temp2

End Sub


Private Sub zera()

optpag(0).Value = Unchecked

optpag(1).Value = Unchecked

optpag(2).Value = Unchecked

optpag(3).Value = Unchecked

optpag(4).Value = Unchecked

optpag(5).Value = Unchecked

optpag(6).Value = Unchecked
End Sub