magikroom
asked on
Update queries...I'm stuck!
Here's the scenario...
I've created an Outlook form that includes VBa to fire the results into an Access table (outlookdata). To get this to work I am using a Linked table from a database that is stored on the network, but the data from the Outlook form is fired into a database on my machine, which includes the linked table from the network.
In a test environment this works fine, when i activate the Macro containing the VBa, it fires into the database on my machine, which in-turn populates the table on the Network...the problem is that I am taking over a database designed by someone else, however the field names are not all the same:
The database on my machine has the following table fields:
SPNumber, FullName, Summary, Impact.
The database I'm taking over (on the network) has the following that contains the same information, but named differently:
SPnumber, Name, Proposal, Decision
Would it be OK to rename the fields on the network database to match the DB on my machine? Or can I do some kind of query that would "convert" the details in say, 'FullName' to 'Name'?
I've created an Outlook form that includes VBa to fire the results into an Access table (outlookdata). To get this to work I am using a Linked table from a database that is stored on the network, but the data from the Outlook form is fired into a database on my machine, which includes the linked table from the network.
In a test environment this works fine, when i activate the Macro containing the VBa, it fires into the database on my machine, which in-turn populates the table on the Network...the problem is that I am taking over a database designed by someone else, however the field names are not all the same:
The database on my machine has the following table fields:
SPNumber, FullName, Summary, Impact.
The database I'm taking over (on the network) has the following that contains the same information, but named differently:
SPnumber, Name, Proposal, Decision
Would it be OK to rename the fields on the network database to match the DB on my machine? Or can I do some kind of query that would "convert" the details in say, 'FullName' to 'Name'?
ASKER
I'm sending it from the Outlook Form to the table on my machine via a bit of code I tracked down and tweaked to suit. The fields (user defined) on the outlook form are identical to the field names in the table on my machine, which is linked from the same table stored on the network...it all works fine, it's just that I was looking for a way to translate one table to another...not the actual data stored in each field:
Public Sub SendAndSaveMessageToAccess ()
On Error GoTo ErrorHandler
Set ins = Application.ActiveInspecto r
Set itm = ins.CurrentItem
If itm.Class <> olMail Then
MsgBox "The active Inspector is not a mail message; exiting"
GoTo ErrorHandlerExit
'Could add more error-trapping to determine if the mail message uses a
'specific custom form, or has specific data in one or more fields
Else
Set msg = itm
'Pick up path to Access database directory from Access SysCmd function
Set appAccess = CreateObject("Access.Appli cation")
strAccessPath = appAccess.SysCmd(acSysCmdA ccessDir)
strAccessPath = strAccessPath & "Outlook Data\"
Debug.Print "Access database path: " & strAccessPath
'Check that there is an Outlook Contacts folder under the Access
'database folder, and exit if not found
Set fso = CreateObject("Scripting.Fi leSystemOb ject")
Set fld = fso.GetFolder(strAccessPat h)
Set dbe = CreateObject("DAO.DBEngine .36")
strDBName = "New Proposals.mdb"
strDBNameAndPath = strAccessPath & strDBName
Debug.Print "Database name: " & strDBNameAndPath
'Test for existence of database
Set fil = fso.GetFile(strDBNameAndPa th)
Set wks = dbe.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBName AndPath)
'Open Access table containing mail message data
Set rst = dbs.OpenRecordset("outlook data")
rst.AddNew
'Save data from custom fields to Access table (if they exist)
Set ups = msg.UserProperties
Set prp = ups.Find("BenefitComments" )
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!BenefitComments = ups("BenefitComments").Val ue
End If
End If
Set prp = ups.Find("FilterGroupComme nts")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!FilterGroupComments = ups("FilterGroupComments") .Value
End If
End If
Set prp = ups.Find("FulNameBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!FulNameBox = ups("FulNameBox").Value
End If
End If
Set prp = ups.Find("GradeBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!GradeBox = ups("GradeBox").Value
End If
End If
Set prp = ups.Find("ImpactComments")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!ImpactComments = ups("ImpactComments").Valu e
End If
End If
Set prp = ups.Find("IncludeDetails")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!IncludeDetails = ups("IncludeDetails").Valu e
End If
End If
Set prp = ups.Find("LiaisonRepBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!LiaisonRepBox = ups("LiaisonRepBox").Value
End If
End If
Set prp = ups.Find("LocationBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!LocationBox = ups("LocationBox").Value
End If
End If
Set prp = ups.Find("RoomBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!RoomBox = ups("RoomBox").Value
End If
End If
Set prp = ups.Find("SecretariatQA")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SecretariatQA = ups("SecretariatQA").Value
End If
End If
Set prp = ups.Find("SectionBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SectionBox = ups("SectionBox").Value
End If
End If
Set prp = ups.Find("StaffNumberBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!StaffNumberBox = ups("StaffNumberBox").Valu e
End If
End If
Set prp = ups.Find("SummaryComments" )
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SummaryComments = ups("SummaryComments").Val ue
End If
End If
Set prp = ups.Find("TelephoneBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!TelephoneBox = ups("TelephoneBox").Value
End If
End If
Set prp = ups.Find("WorkaroundCommen ts")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!WorkaroundComments = ups("WorkaroundComments"). Value
End If
End If
Set prp = ups.Find("WorkaroundNo")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!WorkaroundNo = ups("WorkaroundNo").Value
End If
End If
Set prp = ups.Find("WorkaroundYes")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!WorkaroundYes = ups("WorkaroundYes").Value
End If
End If
Set prp = ups.Find("SPNumber")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SPNumber = ups("SPNumber").Value
End If
End If
rst.Update
rst.Close
dbs.Close
Set wks = Nothing
Set dbe = Nothing
Set appAccess = Nothing
MsgBox msg.Subject & " data has now been exported to the Database"
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
If Err.Number = 76 Then
Set fld = fso.CreateFolder(strAccess Path)
MsgBox strAccessPath & _
" folder created; please copy the appropriate Access database to it and try again"
GoTo ErrorHandlerExit
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Sub
Public Sub SendAndSaveMessageToAccess
On Error GoTo ErrorHandler
Set ins = Application.ActiveInspecto
Set itm = ins.CurrentItem
If itm.Class <> olMail Then
MsgBox "The active Inspector is not a mail message; exiting"
GoTo ErrorHandlerExit
'Could add more error-trapping to determine if the mail message uses a
'specific custom form, or has specific data in one or more fields
Else
Set msg = itm
'Pick up path to Access database directory from Access SysCmd function
Set appAccess = CreateObject("Access.Appli
strAccessPath = appAccess.SysCmd(acSysCmdA
strAccessPath = strAccessPath & "Outlook Data\"
Debug.Print "Access database path: " & strAccessPath
'Check that there is an Outlook Contacts folder under the Access
'database folder, and exit if not found
Set fso = CreateObject("Scripting.Fi
Set fld = fso.GetFolder(strAccessPat
Set dbe = CreateObject("DAO.DBEngine
strDBName = "New Proposals.mdb"
strDBNameAndPath = strAccessPath & strDBName
Debug.Print "Database name: " & strDBNameAndPath
'Test for existence of database
Set fil = fso.GetFile(strDBNameAndPa
Set wks = dbe.Workspaces(0)
Set dbs = wks.OpenDatabase(strDBName
'Open Access table containing mail message data
Set rst = dbs.OpenRecordset("outlook
rst.AddNew
'Save data from custom fields to Access table (if they exist)
Set ups = msg.UserProperties
Set prp = ups.Find("BenefitComments"
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!BenefitComments = ups("BenefitComments").Val
End If
End If
Set prp = ups.Find("FilterGroupComme
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!FilterGroupComments = ups("FilterGroupComments")
End If
End If
Set prp = ups.Find("FulNameBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!FulNameBox = ups("FulNameBox").Value
End If
End If
Set prp = ups.Find("GradeBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!GradeBox = ups("GradeBox").Value
End If
End If
Set prp = ups.Find("ImpactComments")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!ImpactComments = ups("ImpactComments").Valu
End If
End If
Set prp = ups.Find("IncludeDetails")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!IncludeDetails = ups("IncludeDetails").Valu
End If
End If
Set prp = ups.Find("LiaisonRepBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!LiaisonRepBox = ups("LiaisonRepBox").Value
End If
End If
Set prp = ups.Find("LocationBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!LocationBox = ups("LocationBox").Value
End If
End If
Set prp = ups.Find("RoomBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!RoomBox = ups("RoomBox").Value
End If
End If
Set prp = ups.Find("SecretariatQA")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SecretariatQA = ups("SecretariatQA").Value
End If
End If
Set prp = ups.Find("SectionBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SectionBox = ups("SectionBox").Value
End If
End If
Set prp = ups.Find("StaffNumberBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!StaffNumberBox = ups("StaffNumberBox").Valu
End If
End If
Set prp = ups.Find("SummaryComments"
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SummaryComments = ups("SummaryComments").Val
End If
End If
Set prp = ups.Find("TelephoneBox")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!TelephoneBox = ups("TelephoneBox").Value
End If
End If
Set prp = ups.Find("WorkaroundCommen
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!WorkaroundComments = ups("WorkaroundComments").
End If
End If
Set prp = ups.Find("WorkaroundNo")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!WorkaroundNo = ups("WorkaroundNo").Value
End If
End If
Set prp = ups.Find("WorkaroundYes")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!WorkaroundYes = ups("WorkaroundYes").Value
End If
End If
Set prp = ups.Find("SPNumber")
If TypeName(prp) <> "Nothing" Then
If prp.Value <> "" Then
rst!SPNumber = ups("SPNumber").Value
End If
End If
rst.Update
rst.Close
dbs.Close
Set wks = Nothing
Set dbe = Nothing
Set appAccess = Nothing
MsgBox msg.Subject & " data has now been exported to the Database"
End If
ErrorHandlerExit:
Exit Sub
ErrorHandler:
If Err.Number = 76 Then
Set fld = fso.CreateFolder(strAccess
MsgBox strAccessPath & _
" folder created; please copy the appropriate Access database to it and try again"
GoTo ErrorHandlerExit
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I hope it was a help.
God bless!
Sam
God bless!
Sam
ASKER
Yeah it was, I tried to alter rst!NameBox = ups("FulNameBox").Value, but altered "("FulNameBox")." as well and it didn't work...now sorted...cheers
Jamie
Jamie
I would recommend caution on renaming the fields in the table on the server in case there is anything else that uses that table. It would see easier to re-wrok your current project to use the new names then to try to figure out all the things that depend on the old names and re-work them.