[Resolvido]Modulo de verificacão de conexão de Internet

Amigos.. estou usando este código do Amigo João Paulo



Public Function VerificaInternet() As Long
'By JPaulo ® Maximo Access
Dim strResultado As Long
VerificaInternet = InternetGetConnectedState(strResultado, 0)
End Function


Ocorre que mesmo se eu desconectar ele me retorna valor igual a 1 - Dizendo que há conexão..


Será porcausa da rede sem fio?

Se puderem me ajudar fico grato

Verifiquei aqui.. e mesmo se houver uma conexão simples de rede o módulo devolve o status de conectado..

Algum outro jeito de fazer isso?

Em um Módulo


Option Compare Database

'Declares for direct ping
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Dim X As Boolean
Dim hInet As Long
Dim hUrl As Long
Dim flags As Long
Dim URL As Variant


Public Function CheckConnection()



hInet = InternetOpen(" ", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
If hInet Then
flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
hUrl = InternetOpenUrl(hInet, "http://www.yahoo.com", vbNullString, 0, flags, 0)
If hUrl Then
MsgBox "O seu computador está conectado à Internet", vbInformation, "Verificando Conexão"


Call InternetCloseHandle(hUrl)

Else
MsgBox "O seu computador não está conectado à Internet" & vbCr & "Deve conectar-se à internet para continuar.", vbInformation, "Verificando conexão"
X = False
End If
End If
Call InternetCloseHandle(hInet)
End Function
....................................................
Call CheckConnection

No form eu aplico a útima instrução?

Call CheckConnection


Grato

Yes Brother

Vierão.. testei o seu exemplo e funcionou.. mas preciso aplicá-lo da seguinte maneira

no meu form , no botão enviar tenho dois direcionamentos...

1 - para quando há conexão
2 - para quando não há..

Assim ao clicar no botão enviar, se há conexão o código executa todo o procedimento do Outlook

caso não haja, ele não executa este procedimento e grava a mensagem em uma tabela não enviadas..


Como aplicar essa função neste caso?

e para quê dois botões? Não podes fazer isso com instrução.

If se houver conexão
faz isto
else
faz aquilo

Não seria mais simples?

Toma atençaõ

O Módulo já prevê mensagem para erro na conexão.

Mas como a função está em um módulo fica meio estranho fazer os if's no form..

Apliquei sua solução da seguinte maneira


No módulo do form


Option Compare Database
'Declares for direct ping
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

Dim X As Boolean
Dim hInet As Long
Dim hUrl As Long
Dim flags As Long
Dim URL As Variant





No Botão que envia o email.. coloquei o modulo que checa a conexão... direcionando a dois sub's caso haja ou não conexão...

Private Sub BtnEnviar_Click()
'CHECA A CONEXÃO COM A INTERNET DESVIANDO O BOTÃO PARA O CODIGO CORRESPONDENTE À CONEXÃO
hInet = InternetOpen(" ", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
If hInet Then
flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
hUrl = InternetOpenUrl(hInet, "http://www.yahoo.com", vbNullString, 0, flags, 0)
If hUrl Then
MsgBox "O seu computador está conectado à Internet", vbInformation, "Verificando Conexão"

Call InternetCloseHandle(hUrl)
Call BtnEnviarComConexao

Else
MsgBox "O seu computador não está conectado à Internet" & vbCr & "Deve conectar-se à internet para continuar.", vbInformation, "Verificando conexão"
X = False
Call BtnEnviarSemConexao
End If
End If
Call InternetCloseHandle(hInet)
End Sub




Sub BtnEnviarSemConexao()
Parametros_de_Inicializacao "SysPen.par"
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim rsNaoEnviados As DAO.Recordset
Dim StrNaoEnviados As String

NomeBD = "Syspen_be_Local.accdb"

'String com path para conexão com a base de dados.
StrPathLocal = DirBancoDados & NomeBD
' Conecta ao banco de dados
Set dbBanco = OpenDatabase(StrPathLocal)
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

'Adiciona a mensagem completa na tblEnviados
StrNaoEnviados = ("SELECT * FROM tbl_Nao_Enviados")

Set rsNaoEnviados = db.OpenRecordset(StrNaoEnviados)

rsNaoEnviados.AddNew ' Abre a edição do registro

'********PÁGINA 01*************************************************************************
rsNaoEnviados![Para] = Me.emailpara
rsNaoEnviados![Assunto] = Me.cxAssunto
rsNaoEnviados![Mensagem] = Me.cxCorpo
rsNaoEnviados![Anexo1] = Me.txtAnexo1
rsNaoEnviados![Anexo2] = Me.txtAnexo2
rsNaoEnviados![Anexo2] = Me.txtAnexo3
' Atualiza os dados na tabela
db.Execute "UPDATE Contatos SET Selecionado=0 WHERE Selecionado = -1;"
rsNaoEnviados.Update
Me.lstNaoEnviada.Requery
Set rsNaoEnviados = Nothing
Set db = Nothing
ws.Close
Me.Recalc
Me.Refresh
End Sub

Sub BtnEnviarComConexao()
Parametros_de_Inicializacao "SysPen.par"
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim rsEnviados As DAO.Recordset
Dim StrCaixaSaida As String
Dim SrtEnviados As String
Dim rst As Recordset
Dim Contador As Long


NomeBD = "Syspen_be_Local.accdb"

'String com path para conexão com a base de dados.
StrPathLocal = DirBancoDados & NomeBD
' Conecta ao banco de dados
Set dbBanco = OpenDatabase(StrPathLocal)
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

Set rst = db.OpenRecordset("select count(Selecionado) as Tot from Contatos where Selecionado=-1")
Contador = rst!tot

If Contador = 0 Then
MsgBox "Não foi selecionado e-mail para o envio" & vbCrLf & _
"Cancelando a operação!", vbCritical, "Atenção"
Else

Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")


MsgBox "Faltam dados para o envio do email" & Chr(13) & "Preencha corretamente o formulário." & Chr(13) & Chr(13) & "Envio cancelado...", vbInformation, "Alerta"
cxNome.SetFocus
Exit Sub

Me.rtAguarde.Visible = True

'monta o mail e envia
On Error Resume Next

Dim strAnexo1 As String, strAnexo2 As String, strAnexo3 As String
strAnexo1 = Me.txtAnexo1.Value
strAnexo2 = Me.txtAnexo2.Value
strAnexo3 = Me.txtAnexo3.Value
Call InitializeOutlook
Set objNewMail = gOLApp.CreateItem(olMailItem)
With objNewMail
.Attachments.Add strAnexo1
.Attachments.Add strAnexo2
.Attachments.Add strAnexo3
.To = [emailpara]
'body.Font = 20
.body = "Nome: " & Me.cxNome _
& vbCrLf & "" _
& vbCrLf & "Email: " & [cxEmailUsuario] _
& vbCrLf & "" _
& vbCrLf & [cxCorpo] _
& vbCrLf & "" _
& vbCrLf & "Este email foi enviado por © SYSPEN" _
& vbCrLf & ""
.Subject = [cxAssunto] & " - " & Date
.Send
End With
DoCmd.SetWarnings True

'Modifica o status do campo selecionado na tebela voltando todos ao status "Desmarcado"
db.Execute "UPDATE Contatos SET Selecionado=0 WHERE Selecionado = -1;"

'Adiciona a mensagem completa na tblEnviados
StrEnviados = ("SELECT * FROM tbl_Enviados")

Set rsEnviados = db.OpenRecordset(StrEnviados)
rsEnviados.AddNew ' Abre a edição do registro

'********PÁGINA 01*************************************************************************
rsEnviados![Para] = Me.emailpara
rsEnviados![Assunto] = Me.cxAssunto
rsEnviados![Mensagem] = Me.cxCorpo
rsEnviados![Anexo1] = Me.txtAnexo1
rsEnviados![Anexo2] = Me.txtAnexo2
rsEnviados![Anexo2] = Me.txtAnexo3
' Atualiza os dados na tabela
rsEnviados.Update
MsgBox "Mensagem enviada com sucesso!!!", vbInformation, "Aviso de Envio - © SYSPEN"
MsgBox "Os E-Mail's foram enviados para caixa de Saída.", vbOKOnly + vbInformation, "Enviado"

Set rsEnviados = Nothing
Set db = Nothing
ws.Close
Me.Recalc
Me.Refresh

Me.rtAguarde.Visible = False
Me.cxAssunto = ""
Me.cxCorpo = ""
Me.txtAnexo1 = ""
Me.txtAnexo2 = ""
Me.txtAnexo3 = ""
Me.emailpara = ""

End If
End Sub



Perfect!!


Grato

Visse

esse código do Grande JPaulo, funciona 100% com rede por cabo e wirless

você com a pressa deve ter feito algo de errado, tem de ter mais calma.

funciona no XP ou no Vista, pois o Lib interno é o mesmo "wininet"

'Num modulo

Private Declare Function InternetGetConnectedState Lib "wininet" _
(ByRef dwFlags As Long, _
ByVal dwReserved As Long) As Long

Public Function VerificaInternet() As Long
'By JPaulo ® Maximo Access
Dim strResultado As Long
VerificaInternet = InternetGetConnectedState(strResultado, 0)
End Function

'No evento ao pressionar de um botão

Private Sub SeuBotão_Click()
'By JPaulo ® Maximo Access
If VerificaInternet = 1 Then
MsgBox "Sua Internet está Conetada..."
Else
MsgBox "Sua Internet está Desconetada..."
End If
End Sub

Bem.. e talvez devesse ler melhor o problema que citei ai acima...

Saudações

rapaz você diz que não funciona e diz

Verifiquei aqui.. e mesmo se houver uma conexão simples de rede o módulo devolve o status de conectado

e eu digo-lhe para testar com mais calma, porque funciona sim

Também achei estranho não funcionar.

Ele funciona sim... mas desconectei a net e ele devolveu status de conectado, porque chevou a rede....

O PC estava apenas conectado na rede sem net...

o porque eu não sei.. e o modulo foi aplicado corretamente...e não fiz nada errado..

se observar o codigo que o vieira me passou e mais complexo do que o do JP.. e eu apliquei de maneira exemplar sem erros...

porque eu haveria de errar em um código que é mais simples??

Resolvido.. pode ser algum problema com o 7 sei la..