我遇到的问题是连接我的Save_Record（假设保存和推送信息）＆amp; btn退出（保存和退出）以将表单上输入的信息推送到Web数据库。推送信息的唯一方法是，如果我退出，重新进行并进行一些小改动，那么它就会将其推出。
如果不这样做，我怎样才能做到这一点？
Option Compare Database
Option Explicit
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub btnCancel_Click() '==**== undo changes
On Error Resume Next
RunCommand acCmdUndo
Err = 0
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub btnExit_Click()
DoCmd.Close
End Sub
Private Sub cmdViewPDF_Click()
On Error GoTo Err_cmdViewPDF_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "frm_Images"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_cmdViewPDF_Click:
Exit Sub
Err_cmdViewPDF_Click:
MsgBox Err.Description
Resume Exit_cmdViewPDF_Click
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub Form_AfterUpdate()
'DoCmd.Save
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
[DT_MOD] = Now()
[MstrWinUser] = Forms!frFilter!txtWinUser
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
Private Sub MOREoperInfo_Click()
Dim DocName As String
Dim LinkCriteria As String
DoCmd.Save
DocName = "frmsearch"
DoCmd.OpenForm DocName, , , LinkCriteria
End Sub
'-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**-**
'Save record and close
Private Sub Save_Record_Click()
On Error GoTo Err_Save_Record_Click
[DT_MOD] = Now()
[MstrWinUser] = Forms!frmFilter!txtWinUser
'MsgBox "Saving frm_View"
'Save the record
'If there was a record already in txt box, we will assume it has been created in web
If Trim(txtEOCIncident.Value & vbNullString) = vbNullString Then
Me.txtEOCPushFlag = "0"
RunCommand acCmdSaveRecord
DoCmd.Save
Else
'SET EOC PUSH FLAG
Me.txtEOCPushFlag = "1"
RunCommand acCmdSaveRecord
DoCmd.Save
'TRY TO UPDATE WEB DATA
If (pushEOCData(Me.ID)) Then
'CLEAR PUSH FLAG AND SET PUSHDATE
Me.txtEOCPushFlag = "0"
Me.txtEOCPushDate = Now()
RunCommand acCmdSaveRecord
DoCmd.Save
End If
End If
Exit_Save_Record_Click:
Exit Sub
Err_Save_Record_Click:
MsgBox Error$
Resume Exit_Save_Record_Click
End Sub
'*** 08-20-13 New code. Creates PDF of the Report.
Private Sub btnSaveasPDF_Click()
On Error GoTo Err_btnSaveasPDF_Click
Dim db As Database, rs As Recordset
Dim vFN As String, vPATH As String, vFile As String
Dim blRet As Boolean
Dim stDocName As String
Dim strConstantName As String
stDocName = "rpt_Out"
'added 2014-09-02, MAB
strConstantName = "REPORT_FOLDER"
vPATH = Trim(DLookup("[ConstantValue]", "dbo_Constants", "[ConstantName] = '" & [strConstantName] & "'"))
If Forms!frm_View![DIST] = "1" Or Forms!frm_View![DIST] = "2" Or Forms!frm_View![DIST] = "3" Or Forms!frm_View![DIST] = "4" Then
vFN = Forms!frm_View![ID] & "_" & Forms!frm_View![Typeofreport] & "_" & Month(Now()) & "_" & Day(Now()) & "_" & Year(Now()) & "_" & Hour(Now()) & Minute(Now()) & ".pdf"
'vPATH = "\\...\...\Reports\"
vFile = vPATH & vFN
Else
MsgBox "Please enter your number." & vbCrLf & "It must be a single digit.", vbOKOnly Or vbInformation, "*****"
End If
'write to IMAGES
Set db = CurrentDb
Set rs = db.OpenRecordset("IMAGES")
rs.AddNew
rs!SPL_FILENAME = vFN
rs!SPL_ID = [Forms]![frm_View]![ID]
rs!SPL_MOD_DT = Format$(Now(), "mm/dd/yyyy")
rs!SPL_DOC_TYP = Forms!frm_View![DOC_TYP]
rs!SPL_FILELOC = vFile
rs!SPL_ACTIVE = "-1"
rs.Update
rs.Close
DoCmd.OpenReport "rpt_OUT", acViewPreview
DoCmd.OutputTo acReport, stDocName, acFormatPDF, vFile
MsgBox "An image of this report has been saved.", vbOKOnly Or vbInformation, "*****"
Exit_btnSaveasPDF_Click:
Exit Sub
Err_btnSaveasPDF_Click:
MsgBox Err.Description
Resume Exit_btnSaveasPDF_Click
End Sub
********************PUSHEOCDATA*******************************************
'* iSpillID is the value of SPILL_ID from Spills table for the
'* the record you want to update
'*
'*******************************************************************************
Public Function pushEOCData(iSpillID As Integer) As Boolean
Dim db As Database
Dim sSql As String
Dim strStoredProcSql As String
Dim qdef As DAO.QueryDef
Dim sEOCIncident As String
Dim rs As Recordset
Dim iEOCSpillID, iEOCMat1ID, iEOCMat2ID As Long
Dim iReturn As Integer
Dim dAmount1 As Double
Dim dAmount2 As Double
Dim sSpillResponse As String
Dim sMaterialResponse As String
Dim sEOCSpillID, sEOCMat1ID, sEOCMat2ID As String
Dim iFoundAt As Long
Dim iStart As Long
Dim sTemp As String
Dim bReturn As Boolean
Dim objSpillNode As IXMLDOMNode
Dim objMaterialsNodes As IXMLDOMNodeList
Dim objMaterialNode As IXMLDOMNode
pushEOCData = True
initWEBEoc
iEOCSpillID = -1
iEOCMat1ID = -1
iEOCMat2ID = -1
'RETRIEVE INCIDENT NUMBER FROM DATABASE and associated data
'from the database. Note: this is a stored procedure
Set db = CurrentDb
Set qdef = CurrentDb.CreateQueryDef("")
qdef.Connect = CurrentDb.TableDefs("usysWellHistory").Connect
qdef.ReturnsRecords = True
'
' This stored procedure is written to return a record set with
' fields named the same as in webeoc.
'
'strStoredProcSql = "EXEC RBDMS.SPILL_QUERY @N_SPILLID=" & iSpillID
strStoredProcSql = "{CALL RBDMS.SPILL_QUERY (" & iSpillID & ")}"
qdef.sql = strStoredProcSql
Set rs = qdef.OpenRecordset
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
sEOCIncident = rs!INCIDENTID_NUMBER
If Len(sEOCIncident) < 1 Then
pushEOCData = False
Exit Function
End If
'Get the data from webeoc.
'business rules say that we have to have data
'in webeoc to continue
iReturn = getSpillNode(sEOCIncident, objSpillNode)
If iReturn < 1 Then
'MsgBox "No WEBEoc data exists for EOC Incident: " & sEOCIncident
pushEOCData = False
Exit Function
End If
'grab the data id from the spill data, we will need this later to
'update the materials
sEOCSpillID = objSpillNode.Attributes.getNamedItem("dataid").Text
iEOCSpillID = CLng(sEOCSpillID)
If iEOCSpillID < 1 Then
pushEOCData = False
Exit Function
End If
bReturn = updateEOCSpillData(rs, objSpillNode)
If bReturn = False Then
pushEOCData = False
Exit Function
End If
dAmount1 = rs!AMOUNT1
dAmount2 = rs!AMOUNT2
'Get the materials records from webeoc for this incident number.
iResult = getMaterialNodes(sEOCSpillID, objMaterialsNodes)
If dAmount1 > 0 Then
'If webeoc has one or more materials records for the incident,
'grab the first record and update it with dbase values
If objMaterialsNodes.LENGTH > 0 Then
Set objSpillNode = objMaterialsNodes.Item(0)
'update materials
updateEOCMaterialData rs, objSpillNode, 1
Else
'insert materials
insertEOCMaterialData rs, 1, sEOCSpillID
End If
End If
If dAmount2 > 0 Then
'if webeoc has more than one materials record for the incident,
'grab the second record and update it.
If objMaterialsNodes.LENGTH > 1 Then
Set objSpillNode = objMaterialsNodes.Item(1)
'update materials
updateEOCMaterialData rs, objSpillNode, 2
Else
'insert materials
insertEOCMaterialData rs, 2, sEOCSpillID
End If
End If
Else
'MsgBox "No data needs to be pushed to webeoc for this spill."
pushEOCData = True
Exit Function
End If
rs.Close
End Function