This article demonstrates how you can use a form to programmatically change the paths to linked OLE objects. Paths to linked OLE objects are not exposed in any properties in Microsoft Access. To programmatically change a linked OLE object path, you must remove the object and then insert a new object through a form.
All the linked OLE object files are in the same folder.
All the linked OLE objects in the form will be changed.
The record source of the form will be the deciding factor as to which records are changed.
CAUTION: If you follow the steps in this example, you modify the sample database Northwind.mdb. You may want to back up the Northwind.mdb file and follow these steps on a copy of the database.
Open the Employees form in Design view.
Comment out the code for the OnCurrent event of the form.
Save and then close the Employees form.
Open the Employees form in Form view.
Save all the currently embedded OLE objects into the same folder.
Link the newly saved files into the OLE object field for all records.
Close the Employees form.
Copy the folder that contains the currently linked OLE objects.
Paste the folder into a new location.
Create a new module, and then type the following line in the Declarations section if it is not already there:
Option Explicit
Type or paste the following code into the new module:
Function UpdateOLE(FormName As String, OLEName As String, NewPath As String)
Dim myForm As Form
Dim oldPath As String
Dim rtn As Variant
'Open the form if it is not already open.
DoCmd.OpenForm FormName, acNormal, , , acFormEdit
'Bring the form to the front if it is currently behind other objects.
DoCmd.SelectObject acForm, FormName
Set myForm = Forms(FormName)
'Call the subroutine to make changes to the OLE object in the form.
SetOLEPath myForm, OLEName, NewPath
End Function
Sub SetOLEPath(objform As Form, OLEName As String, NewPath As String)
On Error GoTo ErrSetOLEPath
Dim objOLE As Variant
Dim tmpPath As String
Dim tmpClass As String
Dim iCount As Integer
Dim oldPath As String
Dim rs As Recordset
oldPath = ""
Set rs = objform.Recordset
rs.MoveFirst
Do
objOLE = objform(OLEName)
'Get the current path for the linked OLE object.
oldPath = GetLinkedPath(objOLE)
'Determine the file name from the current path.
If oldPath <> "" Then
iCount = 0
tmpPath = oldPath
Do
iCount = InStr(tmpPath, "\")
If iCount > 0 Then
tmpPath = Mid(tmpPath, iCount + 1)
End If
Loop Until iCount = 0
End If
'Set the new path and file name for the OLE object.
With objform(OLEName)
'OLE object must be enabled and unlocked for modification to take place.
.Enabled = True
.Locked = False
tmpClass = .Class
'Remove the current object; otherwise, the object cannot be changed.
objform.Recordset.Edit
objform.Recordset(objform(OLEName).ControlSource) = ""
objform.Recordset.Update
.OLETypeAllowed = acOLELinked
.Class = tmpClass
'Put in the new path and file name.
.SourceDoc = NewPath & IIf(Right(NewPath, 1) = "\", "", "\") & tmpPath
'Create the actual link
.Action = acOLECreateLink
.SizeMode = acOLESizeZoom
End With
'Move to the next record.
rs.MoveNext
Loop Until rs.EOF
Exit Sub
ErrSetOLEPath:
MsgBox Error
MsgBox Err
Resume Next
End Sub
Function GetLinkedPath(objOLE As Variant) As Variant
Dim strChunk As String
Dim pathStart As Long
Dim pathEnd As Long
Dim path As String
If Not IsNull(objOLE) Then
'Convert string to Unicode.
strChunk = StrConv(objOLE, vbUnicode)
pathStart = InStr(1, strChunk, ":\", 1) - 1
'If mapped drive path is not found, try UNC path.
If pathStart <= 0 Then pathStart = InStr(1, strChunk, "\\", 1)
'If either drive letter path or UNC path is found, determine
'the length of the path by searching for the first null
'character Chr(0) after the path was found.
If pathStart > 0 Then
pathEnd = InStr(pathStart, strChunk, Chr(0), 1)
path = Mid(strChunk, pathStart, pathEnd - pathStart)
GetLinkedPath = path
Exit Function
End If
Else
GetLinkedPath = Null
End If
End Function
To test this function, type the following line in the Immediate window, and then press ENTER.
NOTE: <New path to linked files> is the new path to be used for the linked OLE objects.
?UpdateOLE("Employees", "Photo", "<New path to linked files>")
Back to the top
