| |
kshipp99
Posts: 4
Score: 0
Joined: 1/30/2005
From: USA
Status: offline
|
Hello,
I've modified an Outlook Appointment form by adding a tab that contains user-defined fields. I was working fine before, but now when I enter text into my user-defined fields it just disappears. Does anyone know what could be going on?
'---------------------------------------------------------------------------
'----------Fill in cboProject dropdown w/Projects----------
'---------------------------------------------------------------------------
Option Explicit
Dim m_adoNW
Dim cboProject
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adStateOpen = 1
Function Item_Open()
Dim strNW
Dim objPage
On Error Resume Next
strNW = "K:\PSHARE\Sourcing Department Structure\Procurement Services Project Database\GPS Project Data.mdb"
Set m_adoNW = OpenAccessDB(strNW)
If Not m_adoNW.State Is Nothing Then
Set objPage = Item.GetInspector.ModifiedFormPages("Weekly Task List")
Set cboProject = objPage.Controls("cboProject")
Call FillProjectList()
End If
End Function
Function Item_Close()
On Error Resume Next
If m_adoNW.State = adStateOpen Then
m_adoNW.Close
End If
Set m_adoNW = Nothing
Set cboProject = Nothing
End Function
Function GetMailboxUserName()
Dim objNS
Dim objInbox
Dim strName
Dim intPos
Const olFolderInbox = 6
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
strName = objInbox.Parent.Name
GetMailboxUserName = Replace(strName, "Mailbox - ", "")
Set objInbox = Nothing
Set objNS = Nothing
End Function
Sub FillProjectList()
Dim rstProds
Dim strSQL
On Error Resume Next
Set rstProds = CreateObject("ADODB.Recordset")
strSQL = "select Sourcing_Project_Name from tbl_Sourcing_Projects where Data_Analyst=" & Chr(34) & GetMailBoxUserName() & Chr(34) & ";"
'strSQL = "select Sourcing_Project_Name from tbl_Sourcing_Projects where Data_Analyst=" & Chr(34) & GetMailBoxUserName() & Chr(34) & ";"
rstProds.Open strSQL, m_adoNW, _
adOpenForwardOnly, adLockReadOnly
If rstProds.State = adStateOpen Then
cboProject.Column = rstProds.GetRows
rstProds.Close
End If
Set rstProds = Nothing
End Sub
Function OpenAccessDB(strDBPath)
Dim objADOConn
Dim strConn
On Error Resume Next
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=K:\PSHARE\Sourcing Department Structure\Procurement Services Project Database\GPS Project Data.mdb;"
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
'--------------------------------------------------------
'--------------Fill tbl_Task_List_Data-------------------
'--------------------------------------------------------
Sub SubmitTask_Click()
Dim objConnection
Dim objRecordset
Dim strSQL
Set objConnection = CreateObject("ADODB.Connection")
ObjConnection.Mode = 3
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=K:\PSHARE\Sourcing Department Structure\Procurement Services Project Database\GPS Project Data.mdb;"
strSQL = "tbl_Task_List_Data"
Set objRecordset = CreateObject("ADODB.Recordset")
objRecordset.Open strSQL,objconnection, 1,2,2
objRecordset.AddNew
objRecordset.Fields("Task Actual Time Length") = Item.UserProperties("TskActualTimeLength")
objRecordset.Fields("Task Project") = Item.UserProperties("Project")
objRecordset.Fields("Task Type") = Item.UserProperties("TaskType")
objRecordset.Fields("Task Sourcing Step") = Item.UserProperties("TskSourcingStep")
objRecordset.Fields("Task Responsibility") = Item.UserProperties("TskResponsibility")
objRecordset.Fields("Task Deliver To") = Item.UserProperties("TskDeliverTo")
objRecordset.Fields("Task Completion Status") = Item.UserProperties("TskCompletionStatus")
objRecordset.Fields("Task Percent Complete") = Item.UserProperties("TskPercentComplete")
objRecordset.Fields("Task Results") = Item.UserProperties("TskResults")
objRecordset.Fields("Task Subject") = Item.UserProperties("Subject")
objRecordset.Fields("Task Location") = Item.UserProperties("Location")
objRecordset.Fields("Task Start") = Item.UserProperties("Start")
objRecordset.Fields("Task End") = Item.UserProperties("End")
objRecordset.Fields("Task Organizer") = GetMailboxUserName
objRecordset.Update
objRecordset.Close
objConnection.Close
Set objRecordset = Nothing
Set objConnection = Nothing
Const olSave = 0
Item.Close olSave
msgbox "Your Weekly Task List has been updated."
End Sub
'-------------Pull Sourcing Projects Report-----------------
Sub GetSourcingProjects_Click()
Dim strFilePath
Dim appAccess
Dim SQL_Text
Set appAccess = CreateObject("Access.Application")
Const acCmdZoom75 = 241
Const acViewPreview = 2
Const acExit = 2
strFilePath = "K:\PSHARE\Sourcing Department Structure\Procurement Services Project Database\GPS Project Reporting Tool.mdb"
appAccess.OpenCurrentDatabase strFilePath
appAccess.DoCmd.OpenReport "rpt_Sourcing_Projects_Summary", acViewPreview
appAccess.DoCmd.RunCommand acCmdZoom75
appAccess.DoCmd.Maximize
If appAccess.Visible = False Then
appAccess.Visible = True
End If
Set appAccess = Nothing
End Sub
'-------------Pull Weekly Task List Report-----------------
Sub GetWTL_Click()
Dim strFilePath
Dim appAccess
Dim SQL_Text
Set appAccess = CreateObject("Access.Application")
Const acCmdZoom75 = 241
Const acViewPreview = 2
Const acExit = 2
strFilePath = "K:\PSHARE\Sourcing Department Structure\Procurement Services Project Database\GPS Project Reporting Tool.mdb"
appAccess.OpenCurrentDatabase strFilePath
appAccess.DoCmd.OpenReport "rpt_Employee_Task_List_Personal", acViewPreview
appAccess.DoCmd.RunCommand acCmdZoom75
appAccess.DoCmd.Maximize
If appAccess.Visible = False Then
appAccess.Visible = True
End If
Set appAccess = Nothing
End Sub
|
|
Printable Version
Disappearing user-defined text fields - 
New Messages
No New Messages
Hot Topic w/ New Messages
Hot Topic w/o New Messages
Locked w/ New Messages
Locked w/o New Messages
Post New Thread