用VPN连接远程数据库出现的问题？

我是用VPN连接远程数据库库的，但是存在这样一个问题，就是在运行程序窗体一段时间后，再执行窗体里面的查询按钮就会提示“DBNETLIB [ConnectionOpen (Connect())] SQL SERVER 不存在或拒绝访问”，有的时候提示“网络超时”，必须把程序关掉，再重新运行，这样就好了，但是过一段时间就又会重复上面的过程，这是什么原因呢，真苦恼！是我连接语句的问题还是其他原因，我是把连接数据库的语句写在模块里了。
Option Explicit
'定义全局标量用于连接数据库
Public conn As New ADODB.Connection
Public strconn As String
Public Cmd As New ADODB.Command
Public jgdm As New ADODB.Recordset
Public qy As New ADODB.Recordset'Public objDataLink As MSDASC.DataLinks
Sub Main()
'    If App.PrevInstance = True Then
'        MsgBox " 系统巳在运行中 !!!   ", vbQuestion
'        End
'    End If
    If Not ServerConnect Then
        MsgBox "数据库联接错误，请查看联机帮助文件 !!!  ", vbCritical
        End
    End If
    frmprint.Show
End Sub
Public Function ServerConnect() As Boolean
    ServerConnect = False
    Dim a, b, c As Variant
    Dim database As String
    Dim SQLstatus As StringOn Error GoTo ErrHandle
    SQLstatus = "SQL"
    Select Case UCase(SQLstatus)
    Case "ACCESS"
        'strConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Password='';Data Source=" & App.Path & "\card.mdb"
    Case "SQL"
         strconn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;password=;Initial Catalog=db;Data Source=172.168.1.5"
        End Select
    conn.ConnectionString = strconn
    conn.CommandTimeout = 120
    conn.Open strconn
    ServerConnect = True
    Exit Function
ErrHandle:
    Dim adoErr As ADODB.Error
    If conn.Errors.Count > 0 Then
        For Each adoErr In conn.Errors
            MsgBox "[Error Code] " & adoErr.Number & Chr(13) & adoErr.Description, vbCritical + vbOKOnly, "Error"
        Next adoErr
    End If
End Function