check if connected to the internet

I have the following code but i need to amend it. sometimes my broadband connection drops, or the pc has shut down and restarted.

I need to be able to check that the connection to the sharepoint site is open and if it is not then to send me an email.

is this possible?

 
Public Function Command()
   Dim sSql As String
   Dim rs As New ADODB.Recordset
   Dim sFilename As String
   Dim fhFile As Integer
   Dim sLine As String

   sFilename = "\\sharepoint.bt.com@SSL\DavWWWRoot\sites\Ops_Storage_Area\Shared Documents\textfile.txt"
   fhFile = FreeFile
   Open sFilename For Output As #fhFile

   sSql = "SELECT * FROM TblXMLData ORDER BY [sent] DESC"
   rs.Open sSql, CurrentProject.Connection, , adLockOptimistic, adCmdText
   Do While Not (rs.EOF)
      sLine = "<div>" & vbCrLf & "<div class=""message"">" & vbCrLf & "<br />" & _
rs![Sent] & "," & rs![Incident] & "," & rs![Subject] & vbCrLf & "</div>" & vbCrLf
      Print #fhFile, sLine
      rs.MoveNext
   Loop
   rs.Close
   Set rs = Nothing
   Close fhFile
End Function

Open in new window

bryanscott53Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Dezzar82Commented:
you could just check if the file exists. If your connection drops out, the file wont exist etc..

Place this code into a new module:
Function FileOrDirExists(PathName As String) As Boolean
Dim iTemp As Integer
On Error Resume Next

iTemp = GetAttr(PathName)
     
Select Case Err.Number
Case Is = 0
    FileOrDirExists = True
Case Else
    FileOrDirExists = False
End Select

On Error GoTo 0

End Function

Open in new window


Then modify your code to the following:

Public Function Command()
   Dim sSql As String
   Dim rs As New ADODB.Recordset
   Dim sFilename As String
   Dim fhFile As Integer
   Dim sLine As String

   sFilename = "\\sharepoint.bt.com@SSL\DavWWWRoot\sites\Ops_Storage_Area\Shared Documents\textfile.txt"

If FileOrDirExists(sFilename) = True Then
   fhFile = FreeFile
   Open sFilename For Output As #fhFile

   sSql = "SELECT * FROM TblXMLData ORDER BY [sent] DESC"
   rs.Open sSql, CurrentProject.Connection, , adLockOptimistic, adCmdText
   Do While Not (rs.EOF)
      sLine = "<div>" & vbCrLf & "<div class=""message"">" & vbCrLf & "<br />" & _
rs![Sent] & "," & rs![Incident] & "," & rs![Subject] & vbCrLf & "</div>" & vbCrLf
      Print #fhFile, sLine
      rs.MoveNext
   Loop
   rs.Close
   Set rs = Nothing
   Close fhFile
Else
      MsgBox "Unable to locate file. Ensure file exists and your network connection is active",vbExclamation+vbOkOnly,"Command Error"
      Exit Function
End If

End Function

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bryanscott53Author Commented:
Dezzar82, thanks for this. is there any way it could send an email and then close the database?
Dezzar82Commented:
sure...

at what point do you want it to send en email?
Your Guide to Achieving IT Business Success

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

bryanscott53Author Commented:
thanks, rather than the msg box, just in there and then the next step is to close it down?
Dezzar82Commented:
ok, but if your not connected to the network you email probably wont work either...

however.  first thing is you will need a module to create and send an email (if you don't have one already).  I use lotus notes here at my company so all my email code probably wont work for you.

Do a search for a decent bit of code to send emails.

I found a bit of code and have modified it a little to work as a simple function.  I can't test it so give it a go and let me knnow if you need anymore assistance with it.  Outlook would probably already need to be open for this to work.

Place this in a module:
Function SendMail(strTO As String, strSubject As String, strBody As String)
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = strTO
        .Subject = strSubject
        .Body = strBody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Open in new window


And instead of the message box in your code above place:
Else
      Call SendMail("you@mail.com","Application Error!","Application has closed due to connectivity error!")
      DoCmd.Quite 'if you want the entire application to shutdown or
      'DoCmd.Close acForm, Me.Form.Name  if you just want to close the current form
      Exit Function
End If

Open in new window



p912sCommented:
When working with remote computers over the internet I generally use a simple ping command in my code to either wait for or force a connection to restart.

As for sending email, I don't always have access to a local mail server so I use a small executable written in VB6 that sends a message using blat & stunnel thru gmail.com. Stunnel is required to make a secure connection to gmail.

Hope that helps.

Scot

bryanscott53Author Commented:
thanks for all you help this is great
Dezzar82Commented:
no worries Bryan!  your welcome.

Cheers
DeZZar
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.