Do you mean you like to interrupt your macro and then continue the process to not process the already processed files? If so you should create some sort of log text file and append every file path there. When macro runs it should read this file and skip the items already stored in this log.
Application Engineer at Intercad
Tel: +61 2 9454 4444
What I was looking for was a macro to run through a file directory and find all like part numbers, but only grab the most recent and open that and save it as an sldprt. So for example I have one part number say, ABCDE.prt.1, ABCDE.prt.2 and ABCDE.prt.3. I want the macro to only open ABCDE.prt.3 and save it as ABCDE.sldprt then proceed to the next part number. Im still fairly new to VBA in solidworks and have never used it to navigate through file directories.
Ian Barry wrote:
So for example I have one part number say, ABCDE.prt.1, ABCDE.prt.2 and ABCDE.prt.3.
This looks like the files are from ProE and not SolidWorks. You can use the purge option in ProE to clean up the files.
I have no experiance with proE, luckily my company just started the transition to solidwoks as I joined them. I did a little reading as was able to solve my problem. For those of you who care, the following macro opens the latest revised .prt file for each subfolder in a folder, creates new folders called sldprt and jpg in each subfolder. Then saves the part as a sldprt and jpg and puts them in their respected folder.
Dim swApp As Object
Dim FSO As Object
'Place this macro in the folder where the prt files are you'd like to convert
'It will convert the lastest revision for each part into a sldprt and save it to a sldprt folder
'It will also take a picture and save it as a jpeg in a jpg folder
Set swApp = Application.SldWorks
Set FSO = CreateObject("Scripting.FileSystemObject")
sPath = Left(swApp.GetCurrentMacroPathName(), InStrRev(swApp.GetCurrentMacroPathName(), "\"))
Set FSO = Nothing
Dim swModel As SldWorks.ModelDoc
Dim sFileName As String, ssPath As String, findFile As String
Dim modDate As String, sldprtSave As String, jpgSave As String
Dim Part As Object, myModelView As Object, activeModelView As Object, f As Object
Dim file As Object, Files As Object, Folder As Object, fFile As Object
Dim longstatus As Long, longwarnings As Long, i As Long, j As Long
Dim boolstatus As Boolean
Dim checkDate As Date
Set Folder = FSO.GetFolder(sPath)
For Each fldr In Folder.SubFolders 'navigates through each subfolder until it gets to the last one
ssPath = sPath & "\"
sFileName = Dir(ssPath & "*.prt.*")
Do Until sFileName = ""
For Each file In Folder.Files
findFile = Left(sFileName, InStrRev(sFileName, ".prt", , vbTextCompare) - 1) & "*"
checkDate = DateSerial(1950, 1, 1)
sldprtSave = ssPath & "sldprt" & "\"
If Len(Dir(sldprtSave, vbDirectory)) = 0 Then 'creates sldprt folder if it dosent exist to save part into
jpgSave = ssPath & "jpg" & "\"
If Len(Dir(jpgSave, vbDirectory)) = 0 Then 'creates jpg folder if it dosent exist to save part into
For Each fFile In Folder.Files 'checks the modified date to find the lastest revised part
If fFile Like findFile Then
Set f = FSO.GetFile(fFile)
modDate = f.DateLastModified
If modDate > checkDate Then
checkDate = modDate
sFileName = fFile
j = j + 1 'counter to count the number of parts
boolstatus = swApp.LoadFile2(ssPath + sFileName, "B") 'opens the part and imports as geometry with knitting
If boolstatus = True Then 'Checks if the part was able to load
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
Part.ShowNamedView2 "*Isometric", -1
boolstatus = Part.Extension.InsertScene("\scenes\01 basic scenes\11 white kitchen ambient only.p2s") 'changes background to white
Part.SetUserPreferenceToggle swUserPreferenceToggle_e.swDisplayPlanes, False 'hides all planes
myModelView.DisplayMode = swViewDisplayMode_e.swViewDisplayMode_ShadedWithEdges 'adds edges to part
myModelView.FrameState = swWindowState_e.swWindowMaximized 'hides all toolbars for screenshot
Part.SaveAs3 sldprtSave + Part.GetTitle + ".SLDPRT", 0, 0 'saves file as sldprt
Part.SaveAs3 jpgSave + Part.GetTitle + ".JPG", 0, 0 'saves picture as jpg
swApp.CloseDoc Part.GetTitle 'closes the file
i = i + 1 'counts the number of parts that weren't able to be converted
Set swModel = Nothing
sFileName = Dir
Set swApp = Application.SldWorks
Temp = MsgBox(j - i & " parts of " & j & " parts successfully converted", vbOkayOnly, "Conversion Complete")