TreeView in Macro 1

[Creigbm]

I am trying to make one of my macros a little more user friendly, so I am trying to add a feature that will allow the user to select the working directory by using a TreeView format. Does anyone have any experience with this? Thanks in advance.

 

[TheTick]

I believe treeview is one of those ActiveX objects that is not really licensed for VBA (similar problem exists with Common Dialog object).

You may be able to work around this fact using API calls (Declare...lib...etc.), as is often done to invoke Common Dialog in VBA. I have not tried this, though.

All this machinery making modern music can still be open-hearted.

 

[Creigbm]

I was afraid of that. The code for the "Open" and "Save as" written by Stefan Berlitz was a perfect work around for not using common dialog.

 

[TheTick]

I just spent the money to acquire VB6 ($250 for Enterprise editition, used). It's nice being able to program with the full complement of ActiveX and fewer workarounds. Also nice to turn macros into addins.

 

[RawheadRex]

VBA is good for simple automations but if you need any kind of half-way decent UI, one needs to go the VB route. The controls are rather basic in VBA. I've never looked too much into what's there in great detail but I'm pretty sure that you can't get into having folder views and such until you upgrade to VB Learning Edition. Although I wouldn't bet against any resourceful and determined person finding a palatable work-around. Take a peek at FreeVBCode.com there might be some scripts there that could be of assistance.

For what it's worth, I have the full-blown Visual Studio 6.0 suite at work and at home (I had to buy it for a class that I took a couple of years back) and have to say that having the full-blown version of VB is the only way to go if you can get your hands on it. Well worth it in my opinion.

Just my two cents.

Good Luck,
Chris Gervais
Sr. Mechanical Designer
Lytron Corp.

 

[oorah]

Here's some code I used to delete some custom properties with. It has a procedure for displaying a file tree window that I used in an Excel macro. This one recurses subdirectories, you have to comment out four lines near the bottom if you wish to perform your functions on files found ONLY in the directory you pick.

'Batch_DelCustInfo2.swp 08/19/03 by oorah
'
'A batch macro that recurses subdirectories.
'Deletes a Configuration Specific Custom Property for Part files, if it exists,
'without deleting a General Custom Property with the same name.
'
'To run macro:
'1. Must have swConst attached (Program Files...\Samples\appComm\swConst.bas
'2. Open Solidworks but do not open any parts
'3. Select this macro and go

Option Explicit

'Used in the directory function
Dim Msg As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim GetDirectory As String

'Used in the ShowFolderList function
Dim fs, f, f1, fc, s
Dim num As Integer
Dim swApp As Object
Dim Part As Object
Dim Er As Long
Dim Warn As Long
Dim nme As String

'Used in the main function
Dim folderSpec As String
Dim retVal As Boolean

'Used in the directory function
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

'32-bit API declarations used in the directory function
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Sub main()

On Error Resume Next
'Indentify a folder
'Put a message in the next line of code if you wish.
Msg = "Select a folder. This routine also updates subfolders."
'Root folder = Desktop
bInfo.pidlRoot = 0&
'Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
'Type of directory to return
bInfo.ulFlags = &H1
'Display the dialog
x = SHBrowseForFolder(bInfo)
'Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
folderSpec = GetDirectory
Call ShowFolderList(folderSpec) 'call routine
Else
GetDirectory = ""
MsgBox ("Nothing selected, exit macro.&quot
Set swApp = Nothing
Exit Sub
End If
MsgBox "Finished" 'Comment this line out if you know when you are finished or you don’t care"
End Sub

Sub ShowFolderList(folderSpec As String)

Set swApp = CreateObject("sldWorks.application&quot 'Grab ahold of the SolidWorks application
'or create an instance of it
If swApp Is Nothing Then Exit Sub 'If we fail to get the swApp then exit
Part.Visible = True 'Make sure SolidWorks is not running in the background
swApp.UserControl = True ' Give control to the user which will leave SolidWorks up
Set fs = CreateObject("Scripting.FileSystemObject&quot 'Grab ahold of the file system object, kind of like getting windows explorer
Set f = fs.GetFolder(folderSpec) 'Attach to the folder object
Set fc = f.Files 'get a list of files
For Each f1 In fc 'Now we loop through every file in the folder
nme = f1.Name 'Get the file path
If StrComp(UCase(Right(nme, 6)), "SLDPRT&quot = 0 Then 'if it ends with "SLDPRT" then do some more stuff
If StrComp(UCase(Left(nme, 2)), &quot;~$&quot <> 0 Then 'Don’t grab a temporary file
nme = f1.path 'Get the file path instead of the name
Set Part = swApp.OpenDoc6(nme, 1, swOpenDocOptions_Silent, &quot;&quot;, Er, Warn) 'Open the SW file
If Part Is Nothing Then
MsgBox &quot;Failed to Open &quot; & nme 'uncomment this line to see an error message if the macro fails to open a part
GoTo A0001
End If
Set Part = swApp.ActivateDoc(nme) 'make sure it is the active file

'Below this we enter code to do something with the file we opened

retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Revision&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;PartNo&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Description&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;DrawnBy&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;CurrentRev&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Material&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Finish&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;StockType&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;StockWdth&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;StockHgth&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;StockLgth&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;StockID&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;StockOD&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Density&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;StockWeight&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Weight&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Cost&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Project&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;CompanyName&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Department&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev1&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev1Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev1By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev1Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev2&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev2Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev2By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev2Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev3&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev3Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev3By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev3Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev4&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev4Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev4By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev4Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev5&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev5Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev5By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev5Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev6&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev6Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev6By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev6Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev7&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev7Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev7By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev7Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev8&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev8Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev8By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev8Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev9&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev9Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev9By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev9Note&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev10&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev10Date&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev10By&quot
retVal = Part.DeleteCustomInfo2(&quot;Default&quot;, &quot;Rev10Note&quot

'Above this we have entered code to do something with our SW files
'now close the part
Part.Save2 (True) 'uncomment this line to save changes to your sw file
Set Part = Nothing 'Release the Part object
swApp.QuitDoc nme 'close the part doc, do not save changes
A0001:
nme = &quot;&quot; 'Reset the nme variable to nothing so it does not loop accidentally&quot;
End If
End If
Next 'comment the following four lines to avoid recursing subdirectories
Set fc = f.SubFolders 'Now get the sub folders
For Each f1 In fc 'loop through the folders
Call ShowFolderList(f1.path) 'Call this routine for every folder
Next
End Sub

 

[rocheey]

If the control is properly licensed, it can be used in VBA.

Another cheap workaround, if you live in the USA, would be to use a listbox, with a font of &quot;terminal&quot;, and add your own high-bit ascii characters for the Indents. (Any old DOS programmers out there?) But no fonts there, sorry.

 

[TheTick]

re: &quot;If the control is properly licensed, it can be used in VBA.&quot;

Not so. The &quot;proper&quot; license does not apply to VBA. This also carries through to VBA programs written in Excel, Word, others.

 

[TheTick]

Clarification:
If you have a full VB license, you can use these objects in VBA. The VBA license alone does not extend to these objects.

 

[Creigbm]

Thanks oorah, thats exactly what I am looking for.

 

[rocheey]

>>The code for the &quot;Open&quot; and &quot;Save as&quot; written by Stefan
>> Berlitz was a perfect work around for not using common
>> dialog.

FWIW, the 'common dialog', as well as command buttons, forms, check boxes etc, are not some magic VB implemtation... they are already in windows, supported by the windows API, with the code for all of these available in the different windows Dll's.

VB puts a 'wrapper' around them to allow fast event processing.. but in a lot of cases, the controls as implemented by the Windows API have a lot more features/methods/properties that the VB implementation allows.

If you dont mind doing the extra work, you can extend the usefulness of most of these if you use the API. This also applies to VBA ...