I have an .IPT that is linked to a spreadsheet, I am re-Linking that to another spreadsheet. thats all that I need to happen. However When I do So I have a couple of issues. One I get an error that the Ole Links Appear to be Inconsistent as soon as I open the part, if i open the spreadshet through the 3rd party reference it opens the correct spreadsheet but it still wants me to "Change Source" is there a step I missed in my code? and the other issue is mor eof an excel issue but maybe you'll know how to fix it, we have a program that takes a multiline spreadsheet and makes as many copys as there are rows so that it will be in the format inventor can use, ie. Variable Name over Value over Units of measure. the program does this by saving a copy and deleting all rows except the desired one, however if i dont Manually open and save this spreadsheet it wont figure out the formulas and the only dimensions that will import into Inventor properly are the directly entered values such as 32 instead of 15+17. I have the file open and save in my program but that doesnt seem to do the trick. here is the code I am using, I appreciate any help or suggestions.
Dim oXLapp As Object
Set oXLapp = New Excel.Application
oXLapp.Visible = False
Dim SpecificTemplateFolder, TemplatePath, IPTName2
SpecificTemplateFolder = dlgimport.cmbTemplateType.Text
iptpath2 = "W:\Inventor\Templates\Drawing Models\" & SpecificTemplateFolder & "\*.ipt"
IPTPath3 = "W:\Inventor\Templates\Drawing Models\" & SpecificTemplateFolder & "\"
mypathx = "W:\LHW_Jobs\" & myjob & "\Design\DWGS\"
Dim fs, f, f3, fc, ext, iptname
Dim thingy, icntr
mynamex = Dir(mypathx, vbDirectory)
rep1 = -1
Do While mynamex <> ""
mynamex = Dir
Debug.Print mypathx & mynamex
rep = 1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(IPTPath3)
Set fc = f.files
For Each f3 In fc
If UCase(fs.getextensionname(f3)) = "IPT" Then
chkbxnumber = rep + (rep1 * iptqty)
If GetCheck("CheckBox" & chkbxnumber) = True Then
Dim exlPartDoc As Excel.Workbook
Dim exlApp As Excel.Application
Dim exldoc As Workbook
Set exlApp = GetObject(, "Excel.Application")
Set exldoc = exlApp.Workbooks.Open((mypathx & mynamex & "\" & mynamex & ".xls"))
exldoc.RefreshAll
exldoc.Save
exldoc.Close
iptname = fs.getfileName(f3)
FileCopy f3, (mypathx & mynamex & "\" & mynamex & "_" & iptname)
Dim oPartDoc As Inventor.PartDocument
Dim InvApp As Inventor.Application
Dim invdoc As Document
Set InvApp = GetObject(, "Inventor.Application")
InvApp.SilentOperation = True
Set invdoc = InvApp.Documents.Open((mypathx & mynamex & "\" & mynamex & "_" & iptname), True)
Set oPartDoc = ThisApplication.ActiveDocument
Dim oParams As Parameters
Set oParams = oPartDoc.ComponentDefinition.Parameters
Dim oParamTableFiles As ParameterTables
Set oParamTableFiles = oParams.ParameterTables
Dim oParamTableFile As ParameterTable
For Each oParamTableFile In oParamTableFiles
oParamTableFile.FileName = (mypathx & mynamex & "\" & mynamex & ".xls")
Next
Set exldoc = exlApp.Workbooks.Open((mypathx & mynamex & "\" & mynamex & ".xls"))
exldoc.RefreshAll
exldoc.Save
exldoc.Close
oPartDoc.Update
oPartDoc.Update
oPartDoc.Save
oPartDoc.Close
Debug.Print f3; " !!SAVED!!"
added = added + 1
End If
rep = rep + 1
End If
Debug.Print " "
Next
Debug.Print " "
rep1 = rep1 + 1
Loop
oXLapp.Quit
Set oXLapp = Nothing
Dim oXLapp As Object
Set oXLapp = New Excel.Application
oXLapp.Visible = False
Dim SpecificTemplateFolder, TemplatePath, IPTName2
SpecificTemplateFolder = dlgimport.cmbTemplateType.Text
iptpath2 = "W:\Inventor\Templates\Drawing Models\" & SpecificTemplateFolder & "\*.ipt"
IPTPath3 = "W:\Inventor\Templates\Drawing Models\" & SpecificTemplateFolder & "\"
mypathx = "W:\LHW_Jobs\" & myjob & "\Design\DWGS\"
Dim fs, f, f3, fc, ext, iptname
Dim thingy, icntr
mynamex = Dir(mypathx, vbDirectory)
rep1 = -1
Do While mynamex <> ""
mynamex = Dir
Debug.Print mypathx & mynamex
rep = 1
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(IPTPath3)
Set fc = f.files
For Each f3 In fc
If UCase(fs.getextensionname(f3)) = "IPT" Then
chkbxnumber = rep + (rep1 * iptqty)
If GetCheck("CheckBox" & chkbxnumber) = True Then
Dim exlPartDoc As Excel.Workbook
Dim exlApp As Excel.Application
Dim exldoc As Workbook
Set exlApp = GetObject(, "Excel.Application")
Set exldoc = exlApp.Workbooks.Open((mypathx & mynamex & "\" & mynamex & ".xls"))
exldoc.RefreshAll
exldoc.Save
exldoc.Close
iptname = fs.getfileName(f3)
FileCopy f3, (mypathx & mynamex & "\" & mynamex & "_" & iptname)
Dim oPartDoc As Inventor.PartDocument
Dim InvApp As Inventor.Application
Dim invdoc As Document
Set InvApp = GetObject(, "Inventor.Application")
InvApp.SilentOperation = True
Set invdoc = InvApp.Documents.Open((mypathx & mynamex & "\" & mynamex & "_" & iptname), True)
Set oPartDoc = ThisApplication.ActiveDocument
Dim oParams As Parameters
Set oParams = oPartDoc.ComponentDefinition.Parameters
Dim oParamTableFiles As ParameterTables
Set oParamTableFiles = oParams.ParameterTables
Dim oParamTableFile As ParameterTable
For Each oParamTableFile In oParamTableFiles
oParamTableFile.FileName = (mypathx & mynamex & "\" & mynamex & ".xls")
Next
Set exldoc = exlApp.Workbooks.Open((mypathx & mynamex & "\" & mynamex & ".xls"))
exldoc.RefreshAll
exldoc.Save
exldoc.Close
oPartDoc.Update
oPartDoc.Update
oPartDoc.Save
oPartDoc.Close
Debug.Print f3; " !!SAVED!!"
added = added + 1
End If
rep = rep + 1
End If
Debug.Print " "
Next
Debug.Print " "
rep1 = rep1 + 1
Loop
oXLapp.Quit
Set oXLapp = Nothing