jeudi 5 octobre 2017

MS Access VBA : Pushing form information to web

The issue I am having is connect my Save_Record (suppose to save and push info) & btnExit (saves & exits) to push the information inputted on the form to be pushed out to the web database. The only way it will push the information is if I exit out, come back in and make a small change then it will push it out.

Thanks in advance. Please notify me if anything needs to be edited, as this is my first time. greatly appreciate the help!

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

Aucun commentaire:

Enregistrer un commentaire