Tengo 3 equipos con Solidworks, en uno de ellos las Macros funcionan correctamente, en otros dos no funciona ninguna macro y sale el Error mencionado al ejecutar cualquier macro.

Tengo 3 equipos con Solidworks, en uno de ellos las Macros funcionan correctamente, en otros dos no funciona ninguna macro y sale el Error mencionado al ejecutar cualquier macro.

I download the Macro from Festo, it is a Macro that I have not done, I repeat on a PC it works correctly, on two others, it gives me the execution error

https://www.festo.com/eap/es_es/DKI3CAD2/start.do?language=es&country=es&PartNo=2142I have Solidworks 2016 in 3 computers and this macro only works correctly in one of them

--------------------------------------------------------------------------------------------------------------------------------------------------

dim swApp

dim storePath

dim docVisible

#If VBA7 Then

Private Type BROWSEINFO

hwndOwner As LongPtr

pIDLRoot As Long

pszDisplayName As String

lpszTitle As String

ulFlags As Long

lpfnCallback As LongPtr

lParam As LongPtr

iImage As Long

End Type

Private Declare PtrSafe Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long

Private Declare PtrSafe Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)

#Else

Private Type BROWSEINFO

hwndOwner As Long

pIDLRoot As Long

pszDisplayName As Long

lpszTitle As String

ulFlags As Long

lpfnCallback As Long

lParam As Long

iImage As Long

End Type

Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long

Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)

#End If

Private Const MAX_PATH = 260

'Directories only

Private Const BIF_RETURNONLYFSDIRS = &H1&

'Windows 2000 (Shell32.dll 5.0) extended dialog

Private Const BIF_NEWDIALOGSTYLE = &H40

' show edit box

Private Const BIF_EDITBOX = &H10&

Function getLastFeatureByType(model,typ)

Set feat = model.FirstFeature ' Get the 1st feature in part

Set res = Nothing

Count = 0

Do While Not feat Is Nothing ' While we have a valid feature

If feat.GetTypeName() = typ Then

Set res = feat

End If

Set feat = feat.GetNextFeature() ' Get the next feature

Loop ' Continue until no more

Set getLastFeatureByType = res

End Function

' this code with copy a matrix to a other

Function copyMat4x4(source)

Dim res(0 To 15) As Double

For i = 0 To 15

res(i) = source(i)

Next

copyMat4x4 = res

End Function' This code creates a mat from a sw mat

Function createMatFromSWMat(source)

Dim res(0 To 15) As Double

res(0) = source(0)

res(1) = source(1)

res(2) = source(2)

res(3) = 0

res(4) = source(3)

res(5) = source(4)

res(6) = source(5)

res(7) = 0

res(8) = source(6)

res(9) = source(7)

res(10) = source(8)

res(11) = 0

res(12) = source(9)

res(13) = source(10)

res(14) = source(11)

res(15) = source(12)

createMatFromSWMat = res

End Function

Function createSWMatFromMat(source)

Dim res(0 To 15) As Double

res(0) = source(0)

res(1) = source(1)

res(2) = source(2)

res(3) = source(4)

res(4) = source(5)

res(5) = source(6)

res(6) = source(8)

res(7) = source(9)

res(8) = source(10)

res(9) = source(12)

res(10) = source(13)

res(11) = source(14)

res(12) = source(15)

res(13) = 0

res(14) = 0

res(15) = 0

createSWMatFromMat = res

End Function

Function createMat4x4FromValues(x1,x2,x3,y1,y2,y3,z1,z2,z3,t1,t2,t3)

Dim res(0 To 15) As Double

res(0) = x1

res(1) = x2

res(2) = x3

res(3) = 0

res(4) = y1

res(5) = y2

res(6) = y3

res(7) = 0

res(8) = z1

res(9) = z2

res(10) =z3

res(11) = 0

res(12) = t1

res(13) = t2

res(14) = t3

res(15) = 1

createMat4x4FromValues = res

End Function

' this code will mult a common mat with any other stuff

Function multMatMat(ld, xld, yld, rd, xrd, yrd)

mulRes = yld * xrd

'Dim od(0 To 0) As Variant

ReDim od(mulRes - 1) As Double

For i = 0 To mulRes - 1

od(i) = 0#

Next

y = 0

While y < yld

x = 0

While x < xrd

i = 0

While i < xld

od(x * yld + y) = od(x * yld + y) + ld(i * yld + y) * rd(x * yrd + i)

i = i + 1

Wend

x = x + 1

Wend

y = y + 1

Wend

multMatMat = odEnd Function

' this code will mult a vector with a matrix

Function mulMat4x4Values3d(mat, x,y,z)

tmp = createVec4d(x, y, z, 1)

res = multMatMat(mat, 4, 4, tmp, 1, 3)

mulMat4x4Values3d = createVec3d(res(0), res(1), res(2))

End Function

Function mulMat4x4Vec3d(mat, vec)

tmp = createVec4d(vec(0), vec(1), vec(2), 1)

res = multMatMat(mat, 4, 4, tmp, 1, 3)

mulMat4x4Vec3d = createVec3d(res(0), res(1), res(2))

End Function

Function mulMat4x4Mat4x4(mat1, mat2)

mulMat4x4Mat4x4 = multMatMat(mat1, 4, 4, mat2, 4, 4)

End Function

' create a 4x4 matrix

Function createMat4x4()

Dim res(0 To 15) As Double

for i = 0 to 15

res(i) = 0

next

createMat4x4 = res

End Function

Function createMat4x4Ident()

Dim res(0 To 15) As Double

res(0) = 1

res(5) = 1

res(10) = 1

res(15) = 1

res(1) = 0

res(2) = 0

res(3) = 0

res(4) = 0

res(6) = 0

res(7) = 0

res(8) = 0

res(9) = 0

res(11) = 0

res(12) = 0

res(13) = 0

res(14) = 0

createMat4x4Ident = res

End Function

' this function create a new vector

Function createVec3d(x, y, z)

Dim res(0 To 2) As Double

res(0) = x

res(1) = y

res(2) = z

createVec3d = res

End Function

' this function create a new vector

Function createVec4d(x, y, z, w)

Dim res(0 To 3) As Double

res(0) = x

res(1) = y

res(2) = z

res(3) = w

createVec4d = res

End FunctionFunction getMatTVec(mat)

getMatTVec = createVec3d(mat(12), mat(13), mat(14))

End FunctionSub setMatTVec(mat, v)

mat(12) = v(0)

mat(13) = v(1)

mat(14) = v(2)

End Sub

Sub setMatXVec(mat, v)

mat(0) = v(0)

mat(1) = v(1)

mat(2) = v(2)

End Sub

Sub setMatYVec(mat, v)

mat(4) = v(0)

mat(5) = v(1)

mat(6) = v(2)

End Sub

Sub setMatZVec(mat, v)

mat(8) = v(0)

mat(9) = v(1)

mat(10) = v(2)

End Sub

Sub setMatScale(mat, s)

mat(15) = s

End Sub

Function getMatXVec(mat)

getMatXVec = createVec3d(mat(0), mat(1), mat(2))

End Function

Function getMatYVec(mat)

getMatYVec = createVec3d(mat(4), mat(5), mat(6))

End Function

Function getMatZVec(mat)

getMatZVec = createVec3d(mat(8), mat(9), mat(10))

End FunctionFunction negVec3d(v)

negVec3d = createVec3d(-v(0), -v(1), -v(2))

End Function

Function scaleVec3d(v,s)

scaleVec3d = createVec3d(v(0)*s,v(1)*s,v(2)*s)

End Function

' invert a 4x4 matrix

Function invMat4x4(source)

target = copyMat4x4(source)

setMatTVec target, createVec3d(0, 0, 0)

target(1) = source(4)

target(4) = source(1)

target(2) = source(8)

target(8) = source(2)

target(6) = source(9)

target(9) = source(6)

setMatScale target,1

t = getMatTVec(source)

v = mulMat4x4Vec3d(target, t)

setMatTVec target, negVec3d(v)

invMat4x4 = target

End Function

Function IsEqual(argVec3DA, argVec3DB)

For i = 0 To 2

If( argVec3DA(i) <> argVec3DB(i) ) Then

Exit For

End If

Next

If(i = 3) Then

IsEqual = 1

Else

IsEqual = 0

End If

End Function

Function getFaceFromModel(part, pos, normal)

Dim partBodies As Variant

partBodies = part.GetBodies(swSolidBody)

For k = LBound(partBodies) To UBound(partBodies)

found = 0

Dim body As Object

Set body = partBodies(k)

Set face = body.GetFirstFace()

Set getFaceFromModel = nothing

minDist = -1

Do While Not face Is Nothing ' While we have a valid feature

Set sur = face.GetSurface()

If sur.IsPlane() Then

planePara = sur.PlaneParams

faceNormal = face.normal

nTest = faceNormal(0) * normal(0) + faceNormal(1) * normal(1) + faceNormal(2) * normal(2)

If nTest > 1 - 0.000001 Then

' check projection

closeRes = face.GetClosestPointOn(pos(0), pos(1), pos(2))

dTest = (pos(0) - closeRes(0)) * (pos(0) - closeRes(0)) + (pos(1) - closeRes(1)) * (pos(1) - closeRes(1)) + (pos(2) - closeRes(2)) * (pos(2) - closeRes(2))

If ( dTest < minDist Or minDist = -1 ) Then

Set getFaceFromModel = face

minDist = dTest

found=1

End If

End If

else

If sur.IsCylinder() then

closeRes = face.GetClosestPointOn(pos(0), pos(1), pos(2))

dTest = (pos(0) - closeRes(0)) * (pos(0) - closeRes(0)) + (pos(1) - closeRes(1)) * (pos(1) - closeRes(1)) + (pos(2) - closeRes(2)) * (pos(2) - closeRes(2))

If ( dTest < minDist Or minDist = -1 ) Then

res=sur.EvaluateAtPoint(closeRes(0),closeRes(1),closeRes(2))

nTest=res(0)*normal(0)+res(1)*normal(1)+res(2)*normal(2)

if nTest>1-0.00000001 then

Set getFaceFromModel = face

found=1

End if

End if

End if

End if

Set face = face.GetNextFace ' Get the next Face

Loop

If (found = 1) Then

Exit For

End If

Next k

End Function

Function getEdgeFromModel(part, pos,byref edgeRet)

Dim partBodies As Variant

partBodies = part.GetBodies(swSolidBody)

For k = LBound(partBodies) To UBound(partBodies)

Dim body As Object

Set body = partBodies(k)

edges= body.GetEdges()

start= LBound(edges)

ende = UBound(edges)

For i = start To ende

Set edge = edges(i)

closeRes=edge.GetClosestPointOn(pos(0),pos(1),pos(2))

dTest = (pos(0) - closeRes(0)) * (pos(0) - closeRes(0)) + (pos(1) - closeRes(1)) * (pos(1) - closeRes(1)) + (pos(2) - closeRes(2)) * (pos(2) - closeRes(2))

If dTest < 0.00000001 Then

set edgeRet=edge

getEdgeFromModel=true

exit function

End If

Next i

Next k

getEdgeFromModel=false

End Function

sub cLn(part,wMat,x1,y1,x2,y2)

pk1=mulMat4x4Values3d(wMat,x1,y1,0)

pk2=mulMat4x4Values3d(wMat,x2,y2,0)

Part.SketchManager.CreateLine pk1(0),pk1(1),0,pk2(0),pk2(1),0

end sub

sub cCLn(part,wMat,x1,y1,x2,y2)

pk1=mulMat4x4Values3d(wMat,x1,y1,0)

pk2=mulMat4x4Values3d(wMat,x2,y2,0)

Part.CreateCenterLineVB pk1(0),pk1(1),0,pk2(0),pk2(1),0

end sub

sub cArc(part,wMat,x1,y1,x2,y2,x3,y3)

pk1=mulMat4x4Values3d(wMat,x1,y1,0)

pk2=mulMat4x4Values3d(wMat,x2,y2,0)

pk3=mulMat4x4Values3d(wMat,x3,y3,0)

Part.SketchManager.Create3PointArc pk1(0),pk1(1),0,pk3(0),pk3(1),0,pk2(0),pk2(1),0

end sub

sub cCir(part,wMat,x1,y1,rad)

pk1=mulMat4x4Values3d(wMat,x1,y1,0)

Part.SketchManager.CreateCircleByRadius pk1(0),pk1(1),0,rad

end sub

Public Function BrowseForFolder() As String

Dim tBI As BROWSEINFO

Dim lngPIDL As Long

Dim strPath As String

With tBI

.lpszTitle = ""

.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE Or BIF_EDITBOX

End With

lngPIDL = SHBrowseForFolder(tBI)

If (lngPIDL <> 0) Then

' get path from ID list

strPath = Space$(MAX_PATH)

SHGetPathFromIDList lngPIDL, strPath

strPath = Left$(strPath, InStr(strPath, Chr$(0)) - 1)

' release list

CoTaskMemFree lngPIDL

End If

BrowseForFolder = strPath

End Function

Sub SelectCommonEdge(argFaceA, argFaceB)

edgesA = argFaceA.GetEdges

edgesB = argFaceB.GetEdges

For Each edgeA In edgesA

Set vertexA1 = edgeA.GetStartVertex

Set vertexA2 = edgeA.GetEndVertex

pointA1 = vertexA1.GetPoint

pointA2 = vertexA2.GetPoint

For Each edgeB In edgesB

Set vertexB1 = edgeB.GetStartVertex

Set vertexB2 = edgeB.GetEndVertex

pointB1 = vertexB1.GetPoint

pointB2 = vertexB2.GetPoint

If ( (IsEqual(pointA1, pointB1) And IsEqual(pointA2, pointB2)) Or (IsEqual(pointA1, pointB2) And IsEqual(pointA2, pointB1)) ) Then

edgeA.Select(True)

Exit Sub

End If

Next

Next

End Sub

Sub CreatePart0

dim errors as long

dim warnings as long

if (docVisible=0) then

swApp.DocumentVisible 0, 1

end if

set res=swApp.OpenDoc6 ( storePath & "2142 KD3-1_8-A.sldprt",1,3,"", errors, warnings)

if not res is nothing then

if (docVisible=0) then

swApp.DocumentVisible 1, 1

end if

exit sub

end if

if (docVisible=0) then

swApp.DocumentVisible 1, 1

end if

Dim longstatus As Long

Dim sPartTemplateName As String

sPartTemplateName = swApp.GetUserPreferenceStringValue(8)

Set part = swApp.NewDocument(sPartTemplateName, 0, 0, 0)

swApp.ActivateDoc2 "2142 KD3-1_8-A.sldprt", False, longstatus

Set part = swApp.ActiveDoc**part.SketchManager.AddToDB = true**

part.SketchManager.DisplayWhenAdded = false

part.ActiveView.EnableGraphicsUpdate = false

Set modelExt = part.Extension

Set customPropMgr = modelExt.CustomPropertyManager("")

customPropMgr.Add2 "NN", 30, "KD3"

customPropMgr.Add2 "NT", 30, "Quick coupling socket"

customPropMgr.Add2 "NB", 30, "2142 KD3-1/8-A"

customPropMgr.Add2 "NBSYN", 30, "$TNR. $TYP."

customPropMgr.Add2 "LINA", 30, "2142 KD3-1/8-A"

customPropMgr.Add2 "TNR", 30, "2142"

customPropMgr.Add2 "TYP", 30, "KD3-1/8-A"

customPropMgr.Add2 "SUPPLIER", 30, "FESTO"

customPropMgr.Add2 "ARTICLENO", 30, "2142 KD3-1/8-A"

customPropMgr.Add2 "BOMINFO", 30, "2142 KD3-1/8-A"

customPropMgr.Add2 "CREATOR", 30, "CADENAS GmbH"

customPropMgr.Add2 "IsFastener", 30, "0"

part.SummaryInfo(0)="2142 KD3-1/8-A"

part.SummaryInfo(4)="Quick coupling socket"

part.SummaryInfo(2)="Cadenas PARTsolutions"

valRGB=part.MaterialPropertyValues

valRGB(0)=0.68999999761581

valRGB(1)=0.68999999761581

valRGB(2)=0.68999999761581

part.MaterialPropertyValues=valRGB

Dim featMgr as object

set featMgr = part.FeatureManager

codeBag0 part,featMgr

part.ActiveView.EnableGraphicsUpdate = true

part.SketchManager.DisplayWhenAdded = true

part.SketchManager.AddToDB = false

part.EditRebuild3

part.Rebuild swRebuildAll

Set modelExt = part.Extension

modelExt.SaveAs storePath & "2142 KD3-1_8-A.sldprt",0,0,nothing,errors,warnings

End Sub

sub codeBag1(part,wMat)

cLn part,wMat,-0.036,0.004283,-0.036,0.0035392304845413

cLn part,wMat,-0.036,0.0035392304845413,-0.0342,0.0025

cLn part,wMat,-0.0342,0.0025,-0.01846,0.0025

cLn part,wMat,-0.01846,0.0025,-0.01846,0.007

cLn part,wMat,-0.01846,0.007,-0.01185,0.007

cLn part,wMat,-0.01185,0.007,-0.01185,0.0045

cLn part,wMat,-0.01185,0.0045,-0.00035355339059327,0.0045

cLn part,wMat,-0.00035355339059327,0.0045,0,0.0048535533905933

cLn part,wMat,0,0.0048535533905933,0,0.0057

cLn part,wMat,0,0.0057,-0.0003,0.006

cLn part,wMat,-0.0003,0.006,-0.001,0.006

cArc part,wMat,-0.001,0.006,-0.001575,0.006575,-0.00215,0.006

cLn part,wMat,-0.00215,0.006,-0.00455,0.006

cLn part,wMat,-0.00455,0.006,-0.00455,0.0072045729582119

cArc part,wMat,-0.00455,0.0072045729582119,-0.0046234210332599,0.0074011994361618,-0.0048077465204366,0.0075015824588424

cArc part,wMat,-0.0048077465204366,0.0075015824588424,-0.0054533302333392,0.0075891380838212,-0.0061,0.0076682745824737

cLn part,wMat,-0.0061,0.0076682745824737,-0.0061,0.0073884395654343

cArc part,wMat,-0.0061,0.0073884395654343,-0.0064499320946089,0.0074163982279849,-0.0068,0.0074426016488679

cLn part,wMat,-0.0068,0.0074426016488679,-0.0068,0.00785

cLn part,wMat,-0.0068,0.00785,-0.0077,0.00785

cLn part,wMat,-0.0077,0.00785,-0.0077,0.0074510811717862

cArc part,wMat,-0.0077,0.0074510811717862,-0.0080499048301469,0.0074792139427982,-0.0084,0.007504869644129

cLn part,wMat,-0.0084,0.007504869644129,-0.0084,0.008

cLn part,wMat,-0.0084,0.008,-0.0099,0.008

cLn part,wMat,-0.0099,0.008,-0.0099,0.0075866535236669

cArc part,wMat,-0.0099,0.0075866535236669,-0.01185,0.007625,-0.0138,0.0075866535236669

cLn part,wMat,-0.0138,0.0075866535236669,-0.013865716855806,0.0079593523332441

cArc part,wMat,-0.013865716855806,0.0079593523332441,-0.016334171227666,0.0077985161264969,-0.018791649899396,0.0075157903771535

cArc part,wMat,-0.018791649899396,0.0075157903771535,-0.01897637907348,0.0074155522199736,-0.01905,0.0072186956348906

cLn part,wMat,-0.01905,0.0072186956348906,-0.01905,0.0065

cLn part,wMat,-0.01905,0.0065,-0.0207,0.0065

cLn part,wMat,-0.0207,0.0065,-0.021508290376865,0.0079

cLn part,wMat,-0.021508290376865,0.0079,-0.0295,0.0079

cLn part,wMat,-0.0295,0.0079,-0.0295,0.0065

cLn part,wMat,-0.0295,0.0065,-0.0298,0.0065

cLn part,wMat,-0.0298,0.0065,-0.0298,0.006575

cLn part,wMat,-0.0298,0.006575,-0.0314,0.006575

cLn part,wMat,-0.0314,0.006575,-0.0314,0.005

cLn part,wMat,-0.0314,0.005,-0.0298,0.005

cLn part,wMat,-0.0298,0.005,-0.0298,0.004283

cLn part,wMat,-0.0298,0.004283,-0.029992893218813,0.0040901067811865

cArc part,wMat,-0.029992893218813,0.0040901067811865,-0.031082683432365,0.0038733340298618,-0.0317,0.0047972135623731

cLn part,wMat,-0.0317,0.0047972135623731,-0.0317,0.004864

cLn part,wMat,-0.0317,0.004864,-0.035419,0.004864

cLn part,wMat,-0.035419,0.004864,-0.036,0.004283

cCLn part,wMat,0,0,-0.036,0

Part.SketchManager.InsertSketch True

end subsub codeBag2(part,wMat)

cLn part,wMat,-0.01,-0.01,0.01,-0.01

cLn part,wMat,0.01,-0.01,0.01,0.01

cLn part,wMat,0.01,0.01,-0.01,0.01

cLn part,wMat,-0.01,0.01,-0.01,-0.01

cLn part,wMat,-0.007,-0.0040414518843274,0,-0.0080829037686548

cLn part,wMat,0,-0.0080829037686548,0.007,-0.0040414518843274

cLn part,wMat,0.007,-0.0040414518843274,0.007,0.0040414518843274

cLn part,wMat,0.007,0.0040414518843274,0,0.0080829037686548

cLn part,wMat,0,0.0080829037686548,-0.007,0.0040414518843274

cLn part,wMat,-0.007,0.0040414518843274,-0.007,-0.0040414518843274

Part.SketchManager.InsertSketch True

end subsub codeBag0(part,featMgr)

part.CreatePlaneFixed2 createVec3d(0,0,0),createVec3d(0,0,-1),createVec3d(0,1,0),1

set feat4=part.Extension.GetLastFeatureAdded()

feat4.select2 false,0

part.SketchManager.InsertSketch True

part.BlankRefGeom

Set swActiveMat = Part.SketchManager.ActiveSketch

swSketchMat= createMatFromSWMat(swActiveMat.ModelToSketchXForm)

mSkMat=createMat4x4FromValues(0,0,-1,0,1,0,1,0,0,0,0,0)

wMat=mulMat4x4Mat4x4(swSketchMat,mSkMat)

codeBag1 part,wMat

set feat4=part.Extension.GetLastFeatureAdded()

feat4.select2 false,0

featMgr.FeatureRevolve 6.2831853071796,1,6.2831853071796,0,0,1,1,1

if getEdgeFromModel(part,createVec3d(-0.004864,0,0.035419),cylEdge) then

cylEdge.Select(false)

Part.InsertCosmeticThread 0,0.008566,0.0042,""

elseif getEdgeFromModel(part,createVec3d(-0.004864,0,0.0318),cylEdge) then

cylEdge.Select(false)

Part.InsertCosmeticThread 0,0.008566,0.0042,""

End If

part.CreatePlaneFixed2 createVec3d(0,0,0.0295),createVec3d(1,0,0.0295),createVec3d(0,1,0.0295),1

set feat7=part.Extension.GetLastFeatureAdded()

feat7.select2 false,0

part.SketchManager.InsertSketch True

part.BlankRefGeom

Set swActiveMat = Part.SketchManager.ActiveSketch

swSketchMat= createMatFromSWMat(swActiveMat.ModelToSketchXForm)

mSkMat=createMat4x4FromValues(1,0,0,0,1,0,0,0,1,0,0,0.0295)

wMat=mulMat4x4Mat4x4(swSketchMat,mSkMat)

codeBag2 part,wMat

set feat7=part.Extension.GetLastFeatureAdded()

feat7.select2 false,0

featMgr.FeatureCut3 1,0,0,0,0,0.0089,0.0089,1,1,0,0,0,0,0,0,0,0,0,1,1,false,false,false,0,0,0

end subsub main

set swApp = Application.SldWorks

code = swApp.RevisionNumber

found = InStr(code, ".")

If (found > 0) Then

code = Left(code, found-1)

docVisible=1

If (CInt(code) >= 18) Then

docVisible=0

End If

End If

swApp.SetUserPreferenceToggle 11, FALSE

swApp.SetUserPreferenceToggle 97, FALSE

storePath=BrowseForFolder

If (storePath <> "") Then

If ((Right(storePath, 1) <> "\") And (Right(storePath, 1) <> "/")) Then

storePath = storePath + "\"

End If

createPart0

End If

end subTry replacing these lines

Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long

Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)with

Private Declare

**PtrSafe**Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long

Private Declare**PtrSafe**Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare**PtrSafe**Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)and see if that helps.

Thank you very much for all possible solutions, as indicated in the question, there is 1 computer that works correctly with this Macro, but 2 computers that gives execution error.

I have managed to solve it by importing an old Solidworks configuration.

IT IS NOT A MACRO PROBLEMOpt Tron wrote:

Thank you very much for all possible solutions, as indicated in the question, there is 1 computer that works correctly with this Macro, but 2 computers that gives execution error.

I have managed to solve it by importing an old Solidworks configuration.

IT IS NOT A MACRO PROBLEMDoes other computer where it is working has same windows and same SW version as compared to the 2 other whee ti fails? If yes then it is macro problem as macro is made to run on older version.

Check reply from Simon below

I'm certain that the error is due to not having the default part template set in the options.

That's why "importing an old Solidworks configuration" solves the problem. I guess that means loading the settings from a machine where the default part template is set.

I tried the macro without a default part template set and got the error.

Simon Turner wrote:

I'm certain that the error is due to not having the default part template set in the options.

That's why "importing an old Solidworks configuration" solves the problem. I guess that means loading the settings from a machine where the default part template is set.

I tried the macro without a default part template set and got the error.

I agree with you and my above statement is incorrect. I thought that OP is referring to older version of SW.

Can you attach your macro to check? Also what line SW points to when you click on Depurar (debug) ?