如果连接丢失,则停止宏

时间:2014-04-03 15:05:02

标签: sql sql-server vba access-vba

我有一系列在指定时运行的代码,第一个是连接检查。如果它成功,那么它允许代码继续,如果不是它完全停止它。但我担心在此过程之后连接丢失时会发生什么。在此过程中,有一个本地表上的数据上传到我们的SQL服务器,如果连接在中间下载时终止,有时数据仍然会被传输,但如果它立即发生则不会。

代码的第二部分删除包含员工信息的所有本地表内容,然后下载新数据,以便在有任何更新时提供最新信息。

我试图弄清楚是否有一个方法或代码可以实现,以便在连接丢失时告诉查询停止运行,或者如果有的话可以撤消它。

或者将连接代码与上传和删除代码结合起来是一个好主意,以便它在每次启动流程之前运行?

开头的连接代码是:

Public Function StartUp()
Dim cnn As ADODB.Connection
Dim localrst As New ADODB.Recordset
Dim remoterst As New ADODB.Recordset


On Error Resume Next
Set cnn = New ADODB.Connection


cnn.Open "Provider=PRO; Data Source=SOURCE; Initial Catalog=CAT;" _
& "User Id=ID; Password=PW;"

If cnn.State = adStateOpen Then
  MsgBox ("You have an established connection with the L&TD SQL Server Database and the CDData table has been uploaded to the server.")
Else
MsgBox ("Cannot connect to SQL Server. Data will be stored locally to CDData Table until application is opened again with an established connection.")
End
End If

On Error GoTo 0

' MsgBox ("Please wait while the database is updating, this may take a moment.")

End Function

如您所见,我在END IF之前放置了一个END,所以如果没有连接,它就会完全结束。

UPLOAD代码

Public Function Update()
Dim cdb As DAO.Database, qdf As DAO.QueryDef

Dim rs As DAO.Recordset

Dim err As DAO.Error

'    Const DestinationTableName = "AC_CDData"

Const ConnectionString = _
        "ODBC;" & _
            "Driver={SQL Server Native Client 10.0};" & _
            "Server=SERV;" & _
            "Database=DB;" & _
            "UID=ID;" & _
            "PWD=PWD;"
Set cdb = CurrentDb
Set qdf = cdb.CreateQueryDef("")

Set rs = CurrentDb.OpenRecordset("CDData", dbOpenTable)

qdf.Connect = ConnectionString

Do While Not rs.EOF

    qdf.SQL = "INSERT INTO AC_CDData_1(EmployeeID, EmployeeName, Region, District, Function1, Gender, EEOC, Division, Center, MeetingReadinessLevel, ManagerReadinessLevel, EmployeeFeedback, DevelopmentForEmployee1, DevelopmentForEmployee2, DevelopmentForEmployee3, DevelopmentForEmployee4, DevelopmentForEmployee5, Justification, Notes, Changed, JobGroupCode, JobDesc, JobGroup) " & _
               "Values (" & _
               "'" & rs!EmployeeID & "', " & _
               "'" & rs!EmployeeName & "', " & _
               "'" & rs!Region & "', " & _
               "'" & rs!District & "', " & _
               "'" & rs!Function1 & "', " & _
               "'" & rs!Gender & "', " & _
               "'" & rs!EEOC & "', " & _
               "'" & rs!Division & "', " & _
               "'" & rs!Center & "', " & _
               "'" & rs!ManagerReadinessLevel & "', " & _
               "'" & rs!MeetingReadinessLevel & "', " & _
               "'" & rs!EmployeeFeedback & "', " & _
               "'" & rs!DevelopmentForEmployee1 & "', " & _
               "'" & rs!DevelopmentForEmployee2 & "', " & _
               "'" & rs!DevelopmentForEmployee3 & "', " & _
               "'" & rs!DevelopmentForEmployee4 & "', " & _
               "'" & rs!DevelopmentForEmployee5 & "', " & _
               "'" & rs!Justification & "', " & _
               "'" & rs!Notes & "', " & _
               "'" & rs!Changed & "', " & _
               "'" & rs!JobGroupCode & "', " & _
               "'" & rs!JobDesc & "', " & _
               "'" & rs!JobGroup & "')"


qdf.ReturnsRecords = False
On Error GoTo Update_qdfError
qdf.Execute dbFailOnError
On Error GoTo 0

rs.MoveNext
Loop

rs.Close

Set qdf = Nothing
Set cdb = Nothing
Set rs = Nothing
Exit Function

Update_qdfError:
For Each err In DAO.Errors
    MsgBox err.Description, vbCritical, "Error " & err.Number
Next

End Function

那么有没有办法可以修改连接代码并将其添加到更新代码(减去消息框),所以如果连接断开,它将终止代码?

1 个答案:

答案 0 :(得分:0)

你试过交易吗?在您明确提交事务之前,将插入脚本包装在事务中不会更改数据库。如果在插入期间数据连接丢失,则永远不会调用提交,并且不会更改SQL Server数据。

请参阅http://msdn.microsoft.com/en-us/library/office/ff196400%28v=office.15%29.aspx