vbe7:0010b8a1 error; crash while using Solidworks Macros. How can I solve this? Is this a VBA, Excel or Solidworks issue?

Question

I have put together the code for a Solidworks macro that utilizes Excel design tables to update the parts. When I run the program, it executes the first bit of code, but when I do a Pack & Go of the files it completely crashes the Solidworks Application. It successfully creates a new folder for the new file, but crashes before transferring the new files into this folder. I have compiled the code and debugged without any issues, but I cannot determine the root of the problem. The crash report gives the error code: vbe7:0010b8a1.

I don't believe this is an issue with the code, as it has been checked over many times and has worked in the past.

I am running Solidworks 2022, Microsoft Excel MSO (Version 2208 Build 16.0.15601.20526) 64-bit, and VBA 7.1

System is on Windows 10.0.19045 Build 19045

Any ideas what the root cause of this issue may be? Suggestions on what may fix it?

Thanks

Answer 1

There are valid file paths but I hid them for company privacy. The code was based off an example that was found online and adjusted to our needs. I have also posted on the Solidworks forum but have yet to receive a reply.

Answer 2

'Open assembly

openfile = "Hidden for privacy"

Set swModelDoc = swApp.OpenDoc6(openfile, swDocDRAWING, swOpenDocOptions_Silent, "", errors, warnings)

'Set folder where to save the files

myPath = "Hidden for privacy"

'Checks if folder already exists

If Dir(myPath) <> "" Then

Well, it is clear that this is not your original code, the filename and path are invalid and only a part of the project.

It is conceivable that the Solidworks app has no rights in the folder, or that it is due to some other update on your computer.

No error can be seen here from the VBA side and Excel, this is a Solidworks problem and therefore off-topic here.

Please post your question on the Solidworks forum:
https://forum.solidworks.com/

Andreas.

Answer 3

The code executes up to the point where a folder is created for the new files, but they do not successfully do a Pack & Go of the files into the folder. It crashes the Solidworks app before this happens. The code is several User-forms and sets of code but this is the main form:

Option Explicit

Dim swApp As SldWorks.SldWorks

Dim swModelDoc As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swPackAndGo As SldWorks.PackAndGo

Dim openfile As String, toolNum As String

Dim pgFileNames As Variant, pgFileStatus As Variant

Dim pgSetFileNames() As String

Dim pgGetFileNames As Variant, pgDocumentStatus As Variant

Dim status As Boolean

Dim warnings As Long, errors As Long, i As Long, namesCount As Long

Dim DRWfileName As String, PRTfileName As String

Dim statuses As Variant

Public templateFileName As String, newFileName As String, DRWfile As String

Public fileName As String, partNum As String, myPath As String

Sub main()

Set swApp = Application.SldWorks 

SelectToolFrm.Show 

End Sub

Sub Pack_and_Go_CA()

Set swApp = Application.SldWorks 

'Open assembly 

openfile = "Hidden for privacy"

Set swModelDoc = swApp.OpenDoc6(openfile, swDocDRAWING, swOpenDocOptions\_Silent, "", errors, warnings) 

Set swModelDocExt = swModelDoc.Extension 

'Get Pack and Go object 

Set swPackAndGo = swModelDocExt.GetPackAndGo 

'Get number of documents in assembly 

namesCount = swPackAndGo.GetDocumentNamesCount 

'Include any drawings, SOLIDWORKS Simulation results, and SOLIDWORKS \*\*\*\*ponents 

swPackAndGo.IncludeDrawings = True 

swPackAndGo.IncludeSimulationResults = True 

swPackAndGo.IncludeToolboxComponents = True 

'Get current paths and filenames of the assembly's documents 

status = swPackAndGo.GetDocumentNames(pgFileNames) 

'Get current save-to paths and filenames of the assembly's documents 

status = swPackAndGo.GetDocumentSaveToNames(pgFileNames, pgFileStatus) 

'Enter part number 

Do 

    partNum = InputBox("Enter the Tooling OD.") 

    If StrPtr(partNum) = 0 Then 

        End 

    ElseIf partNum = "" Then 

        MsgBox "Please enter the Tooling OD." 

    End If 

Loop While partNum = "" 

Do 

    toolNum = InputBox("Enter the tool number.") 

    If StrPtr(toolNum) = 0 Then 

        End 

    ElseIf toolNum = "" Then 

        MsgBox "Please enter the tool number." 

    End If 

Loop While toolNum = "" 

'Set folder where to save the files 

myPath = "Hidden for privacy"

'Checks if folder already exists

If Dir(myPath) <> "" Then 

    status = swPackAndGo.SetSaveToName(True, myPath) 

    'Flatten the Pack and Go folder structure; save all files to the root directory 

    swPackAndGo.FlattenToSingleFolder = True 

Else 

    MkDir myPath 

    Debug.Print myPath 

    status = swPackAndGo.SetSaveToName(True, myPath) 

    'Flatten the Pack and Go folder structure; save all files to the root directory 

    swPackAndGo.FlattenToSingleFolder = True 

End If 

'Rename files 

ReDim pgSetFileNames(namesCount - 1) 

For i = 0 To (namesCount - 1) 

     fileName = pgFileNames(i) 

     'Determine type of SolidWorks file based on file extension 

         If InStr(LCase(fileName), "sldprt") > 0 Then 

             fileName = toolNum & ".sldprt" 

         ElseIf InStr(LCase(fileName), "sldasm") > 0 Then 

             fileName = toolNum & ".sldasm" 

         ElseIf InStr(LCase(fileName), "slddrw") > 0 Then 

             fileName = toolNum & ".slddrw" 

         Else 

             'Only packing up SolidWorks files 

             Exit Sub 

         End If 

    pgSetFileNames(i) = myPath & fileName 

Next i 

'Set document paths and names for Pack and Go 

status = swPackAndGo.SetDocumentSaveToNames(pgSetFileNames) 

'Verify document paths and filenames after adding prefix and suffix 

ReDim pgGetFileNames(namesCount - 1) 

ReDim pgDocumentStatus(namesCount - 1) 

status = swPackAndGo.GetDocumentSaveToNames(pgGetFileNames, pgDocumentStatus) 

'Pack and Go 

statuses = swModelDocExt.SavePackAndGo(swPackAndGo) 

swApp.CloseDoc (openfile) 

'Opens new part file 

Open\_PRT\_file 

End Sub

Sub Open_PRT_file()

'Opens new part file 

Dim swModelDoc2 As SldWorks.ModelDoc2 

Set swApp = Application.SldWorks 

newFileName = myPath & fileName 

Debug.Print "new file name = " & newFileName 

Set swModelDoc2 = swApp.OpenDoc6(newFileName, swDocPART, swOpenDocOptions\_Silent, "", errors, warnings) 

swApp.ActivateDoc2 fileName, False, errors 

End Sub

Sub Open_DRW_file()

'Opens new drawing file 

Dim swModel2 As SldWorks.ModelDoc2 

Set swApp = Application.SldWorks 

DRWfile = myPath & toolNum & ".slddrw" 

Debug.Print DRWfile 

Set swModel2 = swApp.OpenDoc6(DRWfile, swDocDRAWING, swOpenDocOptions\_Silent, "", errors, warnings) 

swApp.ActivateDoc2 DRWfile, False, errors 

End Sub

    UPDATE: I have determined that the code runs smoothly until the following statement but I still don't know the problem...

status = swPackAndGo.SetDocumentSaveToNames(pgSetFileNames)

Answer 4

Show me your code.

Andreas.