D
Daniel
Ok, when the Post closes it saves everything in the Post to an Access database and its suppose to grab the autonumber from the access database and place it in a textbox on the Post. But when I open the Post the textbox with the ID number is empty, How do I save the Number when the Post closes?
Function OpenAccessDB(strDBPath)
Const adStateOpen = 1
Dim objADOConn
Dim strConn, UID, PWD
UID = ""
PWD = ""
On Error Resume Next
strConn = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & strDBPath & "; " & _
"User ID=" & UID & "; " & _
"Password=" & PWD & "; "
Set objADOConn = CreateObject("ADODB.Connection")
objADOConn.Open strConn
If (Err = 0) And (objADOConn.State = adStateOpen) Then
Set OpenAccessDB = objADOConn
Else
Set OpenAccessDB = Nothing
End If
Set objADOConn = Nothing
End Function
'----------------------------------------------------------- ------------------------------------------------------------ -
Function GetNewNumber()
Const adLockOptimistic = 3
Const adOpenDynamic = 2
Dim adoConn 'As ADODB.Connection
Dim rstHelpDesk 'As ADODB.Recordset
Dim strPath 'As String
Dim strSQL 'As String
Dim strName 'As String
Dim FormID
' ### USER OPTION ###
' path to HelpDesk database
strPath = "C:\HelpDesk\HelpDesk.mdb"
Set adoConn = OpenAccessDB(strPath)
strSQL = "SELECT * FROM [HelpDesk];" 'was "SELECT [ID] FROM HelpDesk;"
Set rstHelpDesk = CreateObject("ADODB.Recordset")
rstHelpDesk.Open strSQL, adoConn , adOpenDynamic, adLockOptimistic
If Item.UserProperties("ID") = "" Then
rstHelpDesk.AddNew
rstHelpDesk.Fields("ComputerName") = Item.UserProperties("Computer Name")
rstHelpDesk.Fields("Date") = Item.UserProperties("Date")
rstHelpDesk.Fields("AVG") = Item.UserProperties("AVG")
rstHelpDesk.Fields("Mas200") = Item.UserProperties("Mas200")
rstHelpDesk.Fields("Unexplained Popups") = Item.UserProperties("Unexplained Popups")
rstHelpDesk.Fields("Virus/Trojans") = Item.UserProperties("Virus/Trojans")
rstHelpDesk.Fields("Windows") = Item.UserProperties("Windows")
rstHelpDesk.Fields("Other") = Item.UserProperties("Other")
rstHelpDesk.Fields("Other Text") = Item.UserProperties("Other2")
rstHelpDesk.Fields("Description") = Item.UserProperties("Description")
rstHelpDesk.Fields("Was Anything Installed") = Item.UserProperties("Installed")
Else
FormID = "ID = " & Item.UserProperties("ID")
rstHelpDesk.Find FormID
rstHelpDesk.Fields("how to") = Item.UserProperties("How to")
rstHelpDesk.Fields("did it work?") = Item.UserProperties("Option")
rstHelpDesk.Fields("if no") = Item.UserProperties("If no")
rstHelpDesk.Fields("Is this Issue Resolved?") = Item.UserProperties("Option2")
rstHelpDesk.Fields("Notes") = Item.UserProperties("Note")
End if
rstHelpDesk.Update
Item.UserProperties("ID")= rstHelpDesk.Fields("ID") <-- doesn't save
Msgbox Item.UserProperties("ID") <--the messagebox does give me a number
rstHelpDesk.Close
adoConn.Close
Set adoConn = Nothing
Set rstHelpDesk = Nothing
End Function
'----------------------------------------------------------- ------------------------------------------------------------ -
Function Item_Close()
Dim Save
Save=msgbox("Do you want to Save this Form to the Database or Cancel?",1,"Save?")
If Save = VbOk Then
GetNewNumber()
End If
End Function.
Submitted using http://www.outlookforums.com
Function OpenAccessDB(strDBPath)
Const adStateOpen = 1
Dim objADOConn
Dim strConn, UID, PWD
UID = ""
PWD = ""
On Error Resume Next
strConn = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & strDBPath & "; " & _
"User ID=" & UID & "; " & _
"Password=" & PWD & "; "
Set objADOConn = CreateObject("ADODB.Connection")
objADOConn.Open strConn
If (Err = 0) And (objADOConn.State = adStateOpen) Then
Set OpenAccessDB = objADOConn
Else
Set OpenAccessDB = Nothing
End If
Set objADOConn = Nothing
End Function
'----------------------------------------------------------- ------------------------------------------------------------ -
Function GetNewNumber()
Const adLockOptimistic = 3
Const adOpenDynamic = 2
Dim adoConn 'As ADODB.Connection
Dim rstHelpDesk 'As ADODB.Recordset
Dim strPath 'As String
Dim strSQL 'As String
Dim strName 'As String
Dim FormID
' ### USER OPTION ###
' path to HelpDesk database
strPath = "C:\HelpDesk\HelpDesk.mdb"
Set adoConn = OpenAccessDB(strPath)
strSQL = "SELECT * FROM [HelpDesk];" 'was "SELECT [ID] FROM HelpDesk;"
Set rstHelpDesk = CreateObject("ADODB.Recordset")
rstHelpDesk.Open strSQL, adoConn , adOpenDynamic, adLockOptimistic
If Item.UserProperties("ID") = "" Then
rstHelpDesk.AddNew
rstHelpDesk.Fields("ComputerName") = Item.UserProperties("Computer Name")
rstHelpDesk.Fields("Date") = Item.UserProperties("Date")
rstHelpDesk.Fields("AVG") = Item.UserProperties("AVG")
rstHelpDesk.Fields("Mas200") = Item.UserProperties("Mas200")
rstHelpDesk.Fields("Unexplained Popups") = Item.UserProperties("Unexplained Popups")
rstHelpDesk.Fields("Virus/Trojans") = Item.UserProperties("Virus/Trojans")
rstHelpDesk.Fields("Windows") = Item.UserProperties("Windows")
rstHelpDesk.Fields("Other") = Item.UserProperties("Other")
rstHelpDesk.Fields("Other Text") = Item.UserProperties("Other2")
rstHelpDesk.Fields("Description") = Item.UserProperties("Description")
rstHelpDesk.Fields("Was Anything Installed") = Item.UserProperties("Installed")
Else
FormID = "ID = " & Item.UserProperties("ID")
rstHelpDesk.Find FormID
rstHelpDesk.Fields("how to") = Item.UserProperties("How to")
rstHelpDesk.Fields("did it work?") = Item.UserProperties("Option")
rstHelpDesk.Fields("if no") = Item.UserProperties("If no")
rstHelpDesk.Fields("Is this Issue Resolved?") = Item.UserProperties("Option2")
rstHelpDesk.Fields("Notes") = Item.UserProperties("Note")
End if
rstHelpDesk.Update
Item.UserProperties("ID")= rstHelpDesk.Fields("ID") <-- doesn't save
Msgbox Item.UserProperties("ID") <--the messagebox does give me a number
rstHelpDesk.Close
adoConn.Close
Set adoConn = Nothing
Set rstHelpDesk = Nothing
End Function
'----------------------------------------------------------- ------------------------------------------------------------ -
Function Item_Close()
Dim Save
Save=msgbox("Do you want to Save this Form to the Database or Cancel?",1,"Save?")
If Save = VbOk Then
GetNewNumber()
End If
End Function.
Submitted using http://www.outlookforums.com