Batch remove FEA links

By Xiaodong Liang

In the same time when I tested the code in the other blog, my colleague Henry Huang in product support team shared a code that can batch delete FEA OLE links. The code is provided by the engineer Paul Zeng. The code is well written. I believe it will be help many other customers. 

Thank you Paul, Henry!

Sub DeleteFEALinksForFolder()'add search paths
    Dim DicList
    Set DicList = CreateObject("Scripting.Dictionary")
    Const SearchPath = "C:\Users\zengp\Desktop\Inv_11229\" 'add more paths if you have
    DicList.Add SearchPath, ""'collect all folders
    Dim FileList, I
    Set FileList = CreateObject("Scripting.Dictionary")
    I = 0
    Do While I < DicList.Count
        Key = DicList.keys
        NowDic = Dir(Key(I), vbDirectory) 'start search folder
        Do While NowDic <> ""
            If (NowDic <> ".") And (NowDic <> "..") And (NowDic <> "OldVersions") Then
                If (GetAttr(Key(I) & NowDic) And vbDirectory) = vbDirectory Then 'find child folder
                    DicList.Add Key(I) & NowDic & "\", ""
                End If
            End If
            NowDic = Dir() 'continue searching
        Loop
        I = I + 1
    Loop'collect all part/assembly files
    For Each Key In DicList.keys
       NowFile = Dir(Key & "*.ipt")
       Do While NowFile <> ""
            FileList.Add Key & NowFile, "" 'Add(Key,Item)  FileList.Key=file name,FileList.Item=file path
            NowFile = Dir()
       Loop
    Next
    For Each Key In DicList.keys
       NowFile = Dir(Key & "*.iam")
       Do While NowFile <> ""
            FileList.Add Key & NowFile, "" 'Add(Key,Item)  FileList.Key=file name,FileList.Item=file path
            NowFile = Dir()
       Loop
    Next'delete FEA file links
    ThisApplication.SilentOperation = True
    For Each strFileName In FileList.keys
        DeleteFEALinksForSingleFile (strFileName)
    Next

    ThisApplication.SilentOperation = False
    
End Sub

Sub DeleteFEALinksForSingleFile(strFullFileName As String)

    Dim oDoc As Document
    Set oDoc = ThisApplication.Documents.Open(strFullFileName)
    
    Dim bHasFEALinksDeleted As Boolean
    bHasFEALinksDeleted = DeleteFEALinks(oDoc)
    If bHasFEALinksDeleted Then
        Call oDoc.Save
        Debug.Print strFullFileName
    End If
    
    Call oDoc.Close
End Sub


Function DeleteFEALinks(oDoc As Document) As Boolean 'if delete links
    DeleteFEALinks = False
    Dim oReferencedOLEFileDescriptors As ReferencedOLEFileDescriptors
    Set oReferencedOLEFileDescriptors = oDoc.ReferencedOLEFileDescriptors
    Dim oOLEFileDescriptor As ReferencedOLEFileDescriptor
    For Each oOLEFileDescriptor In oReferencedOLEFileDescriptors
        Dim strFileName As String
        strFileName = oOLEFileDescriptor.FullFileName
        If (IsFEAOLELinkFile(strFileName)) Then'Debug.Print "Break FEA OLE file link: " + strFileName
          DeleteFEALinks = True
          Call oOLEFileDescriptor.Delete
        End If
    Next
End Function

Function IsFEAOLELinkFile(strFileName As String) As Boolean
    IsFEAOLELinkFile = False

    Dim FEAFileExtArr() As Variant
    FEAFileExtArr = Array(".fins", ".fsat", ".ftes", ".fwiz", ".fmsh", ".fres")
    For Each strFileExt In FEAFileExtArr
      If (InStr(strFileName, strFileExt) > 0) Then
        IsFEAOLELinkFile = True
        Exit For
      End If
    Next

End Function