VBA Code (to insert custom properties) not working on 64bit machines

[Anonymous]

Hi,

We have written some VBA code to insert custom properties into the iproperties for sheet metal components (Sheet blank area, component blank area and stock code number). This code has been working on our 32bit machines for several years.

We have recently upgraded two of our machines (the rest to follow shortly) to Windows XP 64bit, in doing so we have noticed that the VBA code does not work.

We have resolved the issue so that the code will now work with both 32bit and 64bit machines.

My question is; Can you mass replace the VBA code in all of our old drawings (that contain the old code) so that when opened with the new 64bit machines, the code will work and will update accordingly.

Note: i did not write this code and am a complete novice in VBA!

see attached for the old and new code - the bit that has changed is:

(old code) Set oFlatPattern = ThisDocument.ComponentDefinition.FlatPattern

(new code) ThisDocument.InventorDocument.InventorDocument.ComponentDefinition.FlatPattern

I hope this makes sense

Thanks in advance

Regards

Will

[YuhanZhang]

To update the VBA code to make it work for both x86 and x64 Inventors, you can use the

VBComponent.CodeModule.ReplaceLine to do this. But after you update the VBA code you should also

save the document, that means your old documents would be also migrated with current Inventor.

Below is a sample code that will update the ThisDocument in VBA code. You can copy it to a VB6

module, and add references to 'Microsoft Scripting Runtime', and 'Microsoft Visual Basic for

Applications Extensibility x.x'.

Sub Main()
    Dim oApp As Inventor.Application
    Set oApp = GetObject(, "Inventor.Application")
    
    oApp.Documents.CloseAll
    
    ' update all the documents' VBA code in below folder
    Dim sFolder As String
    sFolder = "C:\Mydrawings"
    
    Dim oFSO As New FileSystemObject
    
    Dim oFolder As Folder
    Set oFolder = oFSO.GetFolder(sFolder)
    
    Dim oFile As Scripting.file
    For Each oFile In oFolder.Files
        If Right(LCase(oFile.Name), 3) = "idw" Then
     
            ' open the drawing document
            Dim oDoc As PartDocument
            Set oDoc = oApp.Documents.Open(oFile.Path)
            
            Dim oProj As InventorVBAProject
            For Each oProj In ThisApplication.VBAProjects
            
                Debug.Print oProj.Name
                
                ' process the DocumentProject only
                If oProj.Name = "DocumentProject" Then
                
                    Dim oComp As InventorVBAComponent
                    For Each oComp In oProj.InventorVBAComponents
                        Debug.Print oComp.Name
                        
                        ' process the ThisDocument module only
                        If oComp.Name = "ThisDocument" Then
                            Dim oVBComp As VBComponent
                            Set oVBComp = oComp.VBComponent
                            
                            Dim oCodeModule As CodeModule
                            Set oCodeModule = oVBComp.CodeModule
                            
                            If oCodeModule.Find("ThisDocument", 1, 1, oCodeModule.CountOfLines, 

Len(oCodeModule.Lines(oCodeModule.CountOfLines, oCodeModule.CountOfLines)), True) Then
                                Dim sOldCode As String
                                sOldCode = oCodeModule.Lines(1, oCodeModule.CountOfLines)
                                
                                Dim sUpdatedCode As String
                                sUpdatedCode = Replace(sOldCode, "ThisDocument", 

"ThisDocument.InventorDocument")
                                
                                ' clear the module
                                Call oCodeModule.DeleteLines(1, oCodeModule.CountOfLines)
                                
                                ' write the updated code
                                Call oCodeModule.AddFromString(sUpdatedCode)
                                
                                ' save the change to the document
                                oDoc.Save2 False
                                
                            End If
                             
                        End If
                    
                    Next
                End If
            Next
        End If
        ' close all the opened document(s)
        oApp.Documents.CloseAll
    Next
End Sub

Hope this helps.

[Anonymous]

Hi

Thanks for the reply, This has solved my question (with a small mod to change to part files instead of idw's)

Many thanks

Will