[COLOR=blue]On Error Goto[/color] ErrorCode
(save code statements)
[COLOR=blue]On Error Resume Next[/color]
(scroll to the end of the code)
[COLOR=blue]Exit Sub[/color][COLOR=green]'this makes sure you ignore the error handling code if no error occurred[/color]
ErrorCode: [COLOR=blue]Msgbox [/color]"oh poo"
[COLOR=blue]End Sub[/color]Option Explicit
Dim CurrentDoc As String
Dim LastDoc As String
Dim UpdateArray() As String
Dim DocType As Long
Dim UpdateRetVal As Boolean
Dim SaveState As Boolean
Dim swModel As SldWorks.ModelDoc2
Dim xl As Excel.Application
Dim xlDesTable As Excel.Worksheet
Dim Continue As Integer
Dim Activecolumns As Integer
Dim ColumnCounter As Integer
Dim RowCounter As Integer
Public Parts As Integer
Public Data As Integer
Public ConveyorType As Integer
Dim xlname As String
Public Sub UpdatePart()
'Declarations
Dim swApp As SldWorks.SldWorks
Dim swDesTable As SldWorks.DesignTable
Dim nTotalRow As Long
Dim flError As Long
Dim flWarning As Long
Dim SaveError As Long
Dim SaveWarning As Long
Dim TestCount As Long
Dim Result As Integer
Dim MbResult As Integer
Dim RegenCounter As Integer
Dim ReadState As Boolean
Dim NewConfig As Boolean
Dim Test As Boolean
'Test Assignments
ColumnCounter = 0
'Set SaveState to False
SaveState = False
RegenCounter = 0
ReloadFile:
'Call Application
Set swApp = CreateObject("sldworks.application")
'Make Solidworks Visiable
swApp.Visible = True
'Check for New Update Document
If LastDoc <> CurrentDoc Then
'Check for LastDoc
If LastDoc <> "None" Then
'Close the Last Document Updated
swApp.CloseDoc LastDoc
End If
'Open Model to Update
Set swModel = swApp.OpenDoc6(CurrentDoc, _
DocType, _
swOpenDocOptions_Silent, _
"Default", _
flError, _
flWarning)
End If
'Check for File Errors
Select Case flError
'No Errors
Case 0
'File not found error
Case 2
'Activate Excel Window
AppActivate "Microsoft Excel"
'Warn user of error
MsgBox "An error as occured while" + vbCrLf + _
"opening the file" + vbCrLf + vbCrLf + Chr(&H22) + _
CurrentDoc + Chr(&H22) + vbCrLf + vbCrLf + _
"Please verify that the file exists in" + vbCrLf + _
"in the above location and that the" + vbCrLf + _
"name matches what is shown above." + vbCrLf + _
vbCrLf + "If the file has been moved or renamed" + _
vbCrLf + "on purpose, please update the Part #'s" + _
vbCrLf + "sheet of this file with the new name" + _
vbCrLf + "and location." + vbCrLf + vbCrLf + _
"Exiting update", vbExclamation Or vbOKOnly, _
"File Error"
'Set continue to exit the configuratior
Continue = 0
'Exit the program
Exit Sub
'File already open
Case 65536
'Activate Excel Window
AppActivate "Microsoft Excel"
'Warn user of File Error
MbResult = MsgBox("The file " + Chr(&H22) + CurrentDoc + Chr(&H22) + _
vbCrLf + "is already open in SolidWorks. Please close" + _
vbCrLf + "any documents that are referencing this" + _
vbCrLf + "file and click Retry to continue this update." + _
vbCrLf + vbCrLf + "Clicking cancel will exit this update", _
vbExclamation Or vbRetryCancel, "File Error")
'Check for Message Box response
If MbResult = 4 Then
'Try to reload the file without Errors
GoTo ReloadFile
Else
'Warn user about exit
MsgBox "Exiting Update", vbOKOnly, "Message"
'Set continue to exit the configurator
Continue = 0
'Exit the program
Exit Sub
End If
'Other Errors
Case Else
'Activate Excel Window
AppActivate "Microsoft Excel"
'Warn user of file error
MsgBox "An error has occured while" + vbCrLf + _
"opening the file " + vbCrLf + vbCrLf + Chr(&H22) + _
CurrentDoc + Chr(&H22) + vbCrLf + vbCrLf + _
"For information about this error, please" + vbCrLf + _
"contact John Zelli at Ext. 4805 with the" + vbCrLf + _
"Error Number and File Name" + vbCrLf + vbCrLf + _
"Error Number : " + CStr(flError) + vbCrLf + vbCrLf + _
"Exiting Update", vbExclamation Or vbOKOnly, "File Error"
'Set Continue to exit configurator
Continue = 0
'Exit the Program
Exit Sub
End Select
'Check for File Warnings
Select Case flWarning
'No warnings
Case 0
'File Opens Read Only
Case 2
'Get Write Access
ReadState = swModel.SetReadOnlyState(False)
'Confirm write access granted
If ReadState = 0 Then
'Activate Excel Window
AppActivate "Microsoft Excel"
'Warn user of error
MsgBox "Update cannot continue." + vbCrLf + _
"Write Access for the file" + vbCrLf + vbCrLf + _
Chr(&H22) + CurrentDoc + Chr(&H22) + vbCrLf + vbCrLf + _
"could not be obtained." + vbCrLf + _
"Please verify you have Write Access to" + _
vbCrLf + "this location and run the update again." + _
vbCrLf + vbCrLf + "Exiting Update!", vbExclamation Or vbOKOnly, _
"File Error"
'Set continue to exit the configurator
Continue = 0
'Exit the Program
Exit Sub
End If
'Sharing Error
Case 4
'Activate Excel
AppActivate "Microsoft Excel"
'Warn user another person has the file open for write access
MbResult = MsgBox("A sharing error has been detected while opening the file" + _
vbCrLf + vbCrLf + Chr(&H22) + CurrentDoc + Chr(&H22) + vbCrLf + _
vbCrLf + "WITH THIS WARNING BOX OPEN" + vbCrLf + vbCrLf + _
"Activate the SolidWorks Window" + vbCrLf + "Select File, Reload" + _
vbCrLf + vbCrLf + "In the reload dialog box, find the file in error," + _
vbCrLf + "and get the name of the user with write access." + vbCrLf + vbCrLf + _
"Next contact the user and have them save the file" + vbCrLf + _
"and return the file to Read-Only status." + vbCrLf + _
"(Select File, Make Read Only)." + vbCrLf + vbCrLf + _
"After file has changed to Read-Only, " + vbCrLf + _
"Click Cancel in the Reload dialog box," + vbCrLf + _
"and Retry in this warning box to" + vbCrLf + _
"continue the update" + vbCrLf + vbCrLf + _
"Clicking Cancel will exit the update.", vbExclamation Or vbRetryCancel, _
"File Sharing Error")
'Check user input
If MbResult = 4 Then
swApp.Visible = True
'Close the current doc
swApp.CloseDoc CurrentDoc
'Reopen the file and continue the update
GoTo ReloadFile
Else
'Set continue to exit the configurator
Continue = 0
'Exit the Program
Exit Sub
End If
'Needs Regen
Case 32
'Increment Counter
RegenCounter = RegenCounter + 1
'Check counter status
If RegenCounter = 1 Then
'Regenerate File
swModel.Rebuild swRebuildAll
Else
'Activate Excel Window
AppActivate "Microsoft Excel"
'Send Message to user
MsgBox "The File" + vbCrLf + vbCrLf + Chr(&H22) + _
CurrentDoc + Chr(&H22) + "Could not be Rebuilt" _
+ vbCrLf + vbCrLf + "Please Rebuild manually and resave" + vbCrLf _
+ vbCrLf + "Exiting Update", vbExclamation Or vbOKOnly, "Rebuild Error"
End If
'Save Document
swModel.Save3 swSaveAsOptions_Silent, SaveError, SaveWarning
'Close the current doc
swApp.CloseDoc CurrentDoc
'Reopen the file and continue the update
GoTo ReloadFile
'File Aready Open
Case 128
'Activate Excel Window
AppActivate "Microsoft Excel"
'Warn user of File Error
MbResult = MsgBox("The file " + Chr(&H22) + CurrentDoc + Chr(&H22) + _
vbCrLf + "is already open in SolidWorks. Please close" + _
vbCrLf + "any documents that are referencing this" + _
vbCrLf + "file and click Retry to continue this update." + _
vbCrLf + vbCrLf + "Clicking cancel will exit this update", _
vbExclamation Or vbRetryCancel, "File Error")
'Check for Message Box response
If MbResult = 4 Then
'Try to reload the file without Errors
GoTo ReloadFile
Else
'Warn user about exit
MsgBox "Exiting Update", vbOKOnly, "Message"
'Set continue to exit the configurator
Continue = 0
'Exit the program
Exit Sub
End If
'Other Errors
Case Else
'Activate Excel Window
AppActivate "Microsoft Excel"
'Warn user of file error
MsgBox "An error has occured while" + vbCrLf + _
"opening the file " + vbCrLf + vbCrLf + Chr(&H22) + _
CurrentDoc + Chr(&H22) + vbCrLf + vbCrLf + _
"For information about this error, please" + vbCrLf + _
"contact John Zelli at Ext. 4805 with the" + vbCrLf + _
"Warning Number and File Name" + vbCrLf + vbCrLf + _
"Warning Number : " + CStr(flWarning) + vbCrLf + vbCrLf + _
"Exiting Update", vbExclamation Or vbOKOnly, "File Error"
'Set Continue to exit configurator
Continue = 0
'Exit the Program
Exit Sub
End Select
'Aquire Model Design Table
Set swDesTable = swModel.GetDesignTable
'Open Table for edit
swDesTable.EditTable
'Activate Excel for Design Table Update
Set xl = GetObject(, "excel.application")
'Get # of Rows
nTotalRow = swDesTable.GetTotalRowCount + 1
'Access Design Table In Excel
Set xlDesTable = xl.ActiveWorkbook.Worksheets(1)
'Get WorkBook Name
xlname = xl.ActiveWorkbook.Name
'Confirm the design table is selected for the update
If xlname <> "L Conveyor Configurator.xls" Then
'Paste Match formula into design table
xl.ActiveSheet.Cells(1, 6).Formula = "=ISNUMBER(MATCH(" & Chr(&H22) & _
UpdateArray(0) & Chr(&H22) & ",A3:A" & nTotalRow + 1 & ",0))"
If xl.ActiveSheet.Cells(1, 6).Value = 0 Then
'Clear Cell F1
xl.ActiveSheet.Cells(1, 6).Clear
Else
nTotalRow = xl.WorksheetFunction.Match(UpdateArray(0), _
Range(Cells(3, 1), Cells(nTotalRow + 1, 1)), 0)
'Clear cell F1
xl.ActiveSheet.Cells(1, 6).Clear
End If
'Add New Configuration
Do While ColumnCounter <= Activecolumns
'Add Individual Values to Design Table
xlDesTable.Cells(nTotalRow + 2, ColumnCounter + 1).Value = _
UpdateArray(ColumnCounter)
'Incriment Column Counter
ColumnCounter = ColumnCounter + 1
Loop
'Set update to continue to next part
Continue = 1
Else
'Warn User of file error
MsgBox "Cannot Update Part!" + vbCrLf + _
"The Design Table Did Not Open Correctly" + vbCrLf + vbCrLf + _
"Exiting Update", vbExclamation Or vbOKOnly, _
"File Error"
'Set continue to exit the configurator
Continue = 0
'Exit the Program
Exit Sub
End If
'Set row changed
swDesTable.SetRowChanged nTotalRow
'Update the Design Table
UpdateRetVal = swDesTable.UpdateTable(swUpdateDesignTableSelected, True)
'Confirm table update
If UpdateRetVal = 1 Then
'Save Document
SaveState = swModel.Save3(swSaveAsOptions_Silent, SaveError, SaveWarning)
End If
End Sub
Sub UpdateAssembly()
'Declarations
Dim NFApp As SldWorks.SldWorks
Dim NFModel As SldWorks.ModelDoc2
Dim NFDesTable As SldWorks.DesignTable
Dim NFSave As Boolean
Dim NFUpdate As Boolean
Dim ActiveRows As Integer
Dim UpdateColumn As Integer
Dim UpdateRow As Integer
Dim FNrow As Integer
Dim FileName As String
Dim Extension As String
Dim NFName As String
Dim flError As Long
Dim flWarning As Long
Dim NFErrors As Long
Dim NFWarnings As Long
'Info so control U will update last Conveyor type
Data = Worksheets("Main").Cells(1, 2).Value
Parts = Worksheets("Main").Cells(2, 2).Value
'Close open solidworks docs warning
MsgBox "For better results please save and" + _
vbCrLf + "close all open SolidWorks Documents." + _
vbCrLf + vbCrLf + "Click OK to Continue", _
vbInformation Or vbOKOnly, "Message"
'Set LastDoc to None
LastDoc = "None"
'Set Row Counter for First Data Row
RowCounter = 2
'Activate Part #'s Worksheet
Worksheets(Parts).Activate
'Count # of rows for Update
ActiveRows = Application.WorksheetFunction _
.CountA(Worksheets(Parts).Range("A:A"))
Do While RowCounter <= ActiveRows + 1
'Activate Part #'s Worksheet
Worksheets(Parts).Activate
'Check if Configuration Exists
If Worksheets(Parts).Cells(RowCounter, 3) = False Then
RestartExtensionCheck:
'Get File Path and Name to Update
CurrentDoc = Worksheets(Parts).Cells(RowCounter, 6) + _
Worksheets(Parts).Cells(RowCounter, 4)
'Get File Name
FileName = Worksheets(Parts).Cells(RowCounter, 4)
'Get File Extension
Extension = Right(FileName, Len(FileName) - InStrRev(FileName, "."))
'Assign DocType Based on Extension
Select Case Extension
Case "SLDPRT"
DocType = swDocPART
Case "SLDASM"
DocType = swDocASSEMBLY
Case "SLDDRW"
DocType = swDocDRAWING
Case Else
'Show File Extension Userform
FileExtension.Show vbModal
'Rerun the File Extension Check
GoTo RestartExtensionCheck
End Select
'Get # of Parameters for File Update
Activecolumns = Application.WorksheetFunction _
.CountA(Worksheets(Parts).Rows(RowCounter)) - 7
'Rediminsion the Dynamic Array
ReDim UpdateArray(Activecolumns)
'Zero ColumnCounter
ColumnCounter = 0
'Add Config Name to UpdateArray
UpdateArray(ColumnCounter) = Cells(RowCounter, ColumnCounter + 2)
'Incriment ColumnCounter
ColumnCounter = ColumnCounter + 1
'Assign Information to UpdateArray
Do While ColumnCounter <= Activecolumns
'Assign Individual Values to UpdateArray
UpdateArray(ColumnCounter) = Worksheets(Parts). _
Cells(RowCounter, ColumnCounter + 7).Value
'Incriment ColumnCounter
ColumnCounter = ColumnCounter + 1
Loop
'Call Update Part Function
Call UpdatePart
'Check Continue Status
If Continue = 0 Then
'Stop the Update and Save the Excel File
GoTo SaveExcelFile
End If
'Examine Save Document Return Value
If SaveState = 1 Then
'Activate Excel Window
AppActivate "Microsoft Excel"
'Activate Configurations Worksheet
Worksheets(Worksheets("Main").Cells(3, 2).Value).Activate
'Set Update Column
UpdateColumn = Worksheets(Parts).Cells(RowCounter, 7)
'Select Update Column
Worksheets(Worksheets("Main").Cells(3, 2).Value).Cells(1, UpdateColumn).Select
'Get Active Configuration Count
UpdateRow = Application.WorksheetFunction _
.CountA(Worksheets(Worksheets("Main").Cells(3, 2).Value).Columns(UpdateColumn)) + 1
'Add New Configuration To List
Worksheets(Worksheets("Main").Cells(3, 2).Value).Cells(UpdateRow, UpdateColumn).Value = UpdateArray(0)
'Update Last Doc to Current Doc
LastDoc = CurrentDoc
End If
End If
'Incriment Row Counter
RowCounter = RowCounter + 1
Loop
'Looking for file name row
FNrow = Application.WorksheetFunction.Match("Filename", Worksheets(Data).Range("A:A"), 0)
'Get project file name
NFName = "W:\Macro Project Folder\" + Worksheets(Data).Cells(FNrow, 2) + _
".SLDASM"
'Get number of new File update arguments
Activecolumns = Worksheets(Data).Cells(FNrow + 1, 2).Value
'Redimension the UpdateArray
ReDim UpdateArray(Activecolumns - 1)
'Zero Column Counter
ColumnCounter = 0
'Get update arguments
Do While ColumnCounter < Activecolumns
'Assign individual update values
UpdateArray(ColumnCounter) = Worksheets(Data).Cells(FNrow + 2, ColumnCounter + 1).Value
'Incriment counter
ColumnCounter = ColumnCounter + 1
Loop
'Open Solidworks
Set NFApp = CreateObject("sldworks.application")
'Make Solidworks visible
NFApp.Visible = True
'Close Last Updated Part
NFApp.CloseDoc CurrentDoc
'Open Generic Assembly
Set NFModel = NFApp.OpenDoc6("W:\Macro Project Folder\Generic Assembly.SLDASM", _
swDocASSEMBLY, _
swOpenDocOptions_Silent, _
"", _
flError, _
flWarning)
'Save Generic Conveyor as Project Conveyor
NFSave = NFModel.SaveAs4(NFName, _
swSaveAsCurrentVersion, _
swSaveAsOptions_Silent, _
NFErrors, _
NFWarnings)
'Check nem file saved
If NFSave = 1 Then
'Get the New File Design Table
Set NFDesTable = NFModel.GetDesignTable
'Open table for edit
NFDesTable.EditTable
'Activate Excel for Design Table Update
Set xl = GetObject(, "excel.application")
'Access Design Table in Excel
Set xlDesTable = xl.ActiveWorkbook.Worksheets(1)
'Get Workbook Name
xlname = xl.ActiveWorkbook.Name
'Confirm the design table is selected for update
If xlname <> "L Conveyor Configurator.xls" Then
'Reset Column Counter
ColumnCounter = 0
'Update Default Configuration to Project Configuration
Do While ColumnCounter < Activecolumns
'Add individual Values to Design Table
xlDesTable.Cells(3, ColumnCounter + 2).Value = _
UpdateArray(ColumnCounter)
'Incriment Column Counter
ColumnCounter = ColumnCounter + 1
Loop
'Set continue to give user compleated macro message
Continue = 1
Else
'Warn user of file error
MsgBox "Cannot update the final assembly!" + vbCrLf + _
"The design table did not open correctly" + vbCrLf + _
vbCrLf + "Exiting Update", vbExclamation Or vbOKOnly, _
"Design Table Error"
'Set continue to exit the update
Continue = 0
End If
'Update and close the design table
NFUpdate = NFDesTable.UpdateTable(swUpdateDesignTableAll, True)
'Check for sucessful table update
If NFUpdate = 1 Then
'Save document
NFSave = NFModel.Save3(swSaveAsOptions_Silent, NFErrors, NFWarnings)
End If
End If
SaveExcelFile:
'Activate Excel Window
AppActivate "Microsoft Excel"
'Save Excel File
Workbooks("L Conveyor Configurator.xls").Save
'Check to see that the workbook saved
If Workbooks("L Conveyor Configurator.xls").Saved Then
'Check to see the update compleated
If Continue = 1 Then
'Tell user Configuration is Created
MsgBox "The Assembly has been Created as" + _
vbCrLf + "Configuration " + Chr(&H22) + _
Worksheets(Parts).Cells(ActiveRows + 1, 2) + _
Chr(&H22) + vbCrLf + "in " + Chr(&H22) + _
Worksheets(Parts).Cells(ActiveRows + 1, 4) + _
Chr(&H22), vbInformation Or vbOKOnly, _
"Configuration Compleate"
End If
'Inform user the configurator has been saved
MsgBox "The File " + Chr(&H22) + "L Conveyor Configurator.xls" + _
Chr(&H22) + vbCrLf + "has been saved to reflect the changes made" + _
vbCrLf + "by the configurator", vbOKOnly, "File Saved"
Else
'Inform user the configurator must be saved before exiting
MsgBox "The File " + Chr(&H22) + "L Conveyor Configurator.xls" + _
Chr(&H22) + vbCrLf + "has not been saved. Please save this file before" + _
vbCrLf + "closing to keep changes made by the configurator", _
vbOKOnly Or vbExclamation, "File Unsaved"
End If
End Sub
Sub Wait(Pause As Integer)
Dim NewHour As Variant
Dim NewMinute As Variant
Dim NewSecond As Variant
Dim WaitTime As Variant
NewHour = Hour(Now())
NewMinute = Minute(Now())
NewSecond = Second(Now()) + Pause
WaitTime = TimeSerial(NewHour, NewMinute, NewSecond)
Application.Wait WaitTime
End Sub
Sub Auto_Open()
'Show the TypeConFig Form
TypeConfig.Show vbModeless
End Sub