ACC2000: How to Programmatically Change the Paths to Linked OLE Objects (311147)

MORE INFORMATION

• 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.

1. Open the Employees form in Design view.
2. Comment out the code for the OnCurrent event of the form.
3. Save and then close the Employees form.
4. Open the Employees form in Form view.
5. Save all the currently embedded OLE objects into the same folder.
6. Link the newly saved files into the OLE object field for all records.
7. Close the Employees form.
8. Copy the folder that contains the currently linked OLE objects.
9. Paste the folder into a new location.
10. Create a new module, and then type the following line in the Declarations section if it is not already there:

    Option Explicit
    					

11. 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
    
    					

12. 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>")