Inventor

list of snippets

I am a CAD administrator by profession and I create iLogic scripts. On this page you can find snippets and complete scripts that have created (unless stated otherwise) and I use regularly. Feel free to use them, most of these scripts are adaptations of other rules that can be found on the internet.

CheckCustomProp

Sub to check for custom property in the file, if the property does not exist, we create it. Tested on Inventor 2018

		
	   
		'Sub to check for custom property in the file, if the property does not exist, we create it. Tested on Inventor 2018

		Private Sub CheckCustomProp (PropName As String, Value As String, oDoc As Document)
			customPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
			Dim oPropThickness As Inventor.Property
			Try
				oPropThickness = customPropertySet.Item(PropName)
			Catch
				' Assume error means not found
				oPropThickness = customPropertySet.add("", PropName)
			End Try
			
			If Value <> "" Then oPropThickness.Expression = Value
			InventorVb.DocumentUpdate()
		End Sub<
		
		
CopyCustomProp

iLogic (VB) that copies all custom Inventor properties

The rule has to be executed on a drawing, and it will copy all the custom properties over to a second drawing. This drawing can be chosen with the file dialog box presented to the user.

		
	   
		'Code snippet that copies all custom Inventor properties from drawing to drawing. Tested on Inventor 2018


		Sub Main()
			'assumes that we are running the rule from the source document.
			Dim TargetDrawing As Inventor.Document = ThisApplication.ActiveDocument
			Dim SourceDrawing As Inventor.Document

			'Set File Selection dialogue object
			Dim oFileDlg As Inventor.FileDialog = Nothing
			InventorVb.Application.CreateFileDialog(oFileDlg)
			oFileDlg.InitialDirectory = oOrigRefName
			oFileDlg.CancelError = True
			
			'Set the error handling to next (needed for the detection user pressing cancel)
			On Error Resume Next
			
			oFileDlg.ShowOpen()
			If Err.Number <> 0 Then
				Return
			'check if string is empty
			ElseIf oFileDlg.FileName <> "" Then
				selectedfile = oFileDlg.FileName
			End If
			'open the selected source drawing, using the false setting to open the document Hidden
			SourceDrawing = ThisApplication.Documents.Open(selectedfile,False)
			On Error GoTo 0
			
			'Define both User defined Property sets
			Dim TargetPorps As PropertySet = TargetDrawing.PropertySets.Item("Inventor User Defined Properties")
			Dim SourceProps As PropertySet = SourceDrawing.PropertySets.Item("Inventor User Defined Properties")
			
			'declare the property variable
			Dim oProp As Inventor.Property
			
			'iterate though each user property in the source drawing and create 
			For Each oProp In SourceProps
				On Error Resume Next
				'MessageBox.Show("Trying To add value: " & oProp.Value, "Message for debugging purposes")
				TargetPorps.Add(oProp.Value, oProp.Name)
				'MessageBox.Show("Err.Number: " & Err.Number, "Message for debugging purposes")

				If Err.Number = 5 Then
					'MessageBox.Show("Value is already there: " & oProp.Value, "Message for debugging purposes")
					Dim InvPropery As [Property]
					InvPropery = TargetPorps.Item(oProp.Name)
					InvPropery.Value = oProp.Value
				End If
			Next
			'Close the source drawing without saving
			SourceDrawing.Close(True)
			InventorVb.DocumentUpdate()

			MessageBox.Show("Done copying!", "Custom iProperties copy tool")

		End Sub
		
		
RunRuleInParts

iLogic (VB) Script to run rules in underlying parts.

Runs rule in all occurrences of an assembly (If rule is present in occurrence)

		
	   
		
		'Code snippet that Runs rule in all occurrences of an assembly (If rule is present in occurrence). Tested on Inventor 2018

		Sub Main()
		'Define the Assembly Document
		Dim oDoc As AssemblyDocument 
		Dim RuleName as string = "Test"

		' check if active document is an assembly
		Try
			oDoc = ThisApplication.ActiveDocument
		Catch
			MessageBox.Show("Please run on assembly", "Run Rule")
		End Try

		Dim oOcc As ComponentOccurrence

		GoThrough:
		For Each oOcc In oDoc.ComponentDefinition.Occurrences
				'Get Document from Occurrence 
				Dim oOccDoc As Document
				oOccDoc = oOcc.Definition.Document
				
				'Check if document is a part
				If oOccDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject Then
					
					oOccDoc = oOcc.Definition.Document
					Try
					iLogicVb.RunRule(oOccDoc.DisplayName, RuleName)
					'MessageBox.Show("Rule run in: " & oOccDoc.DisplayName, "Message for debugging purposes")
					Catch
						'MessageBox.Show("Rule not present in: " & oOccDoc.DisplayName, "Message for debugging purposes")
					End Try
				'if the document is an assembly we need to run the same code in each occurrence of that assembly (we uses a goto function)
				Else If oOccDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject	Then 
					oDoc = oOccDoc
					GoTo GoThrough
				End If	
		Next

		End Sub

		
		
Check document type, and sub type
		
		
		Sub Main
		Dim oDoc As Document
		oDoc = ThisDoc.Document
		'Declare the ID for Sheetmetal
		Const CLSID_InventorSheetMetalPart_RegGUID = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"

		'check if Document type is part
		If oDoc.DocumentType <> Inventor.DocumentTypeEnum.kPartDocumentObject Then Exit Sub
		
		'Here is a list of all of the the DocumentType enumerators available in the API:
		'kUnknownDocumentObject 
		'kPartDocumentObject 
		'kAssemblyDocumentObject 
		'kDrawingDocumentObject 
		'kPresentationDocumentObject 
		'kDesignElementDocumentObject 
		'kForeignModelDocumentObject 
		'kSATFileDocumentObject  
		'kNoDocument

		'check If part Is SheetMetal
		If oDoc.SubType = CLSID_InventorSheetMetalPart_RegGUID Then

			Dim sheetMetalDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition

			'Calculate Width and height
			Calc:
			If  sheetMetalDef.HasFlatPattern() Then
							
				Dim oWidth As Double = Round(SheetMetal.FlatExtentsWidth, 3)
				Dim oHeight As Double = Round(SheetMetal.FlatExtentsLength,3)
				Dim oThick As Double = Parameter("Thickness")
						
				'create custom properties for sheet extents.
				CheckCustomProp ("Width", oWidth, oDoc)
				CheckCustomProp ("Height", Height, oDoc)
				CheckCustomProp ("Thickness", oThick, oDoc)
				iProperties.Value("Project", "Description") = "Sheet " & oWidth & "x" & oHeight & "mm T=" & Parameter("Thickness")
			Else
				Uncomment the action that is desired. Crete property to indicate work is necessary or create the flat pattern
				'iProperties.Value("Project", "Description") = "*CREATE FLAT PATTERN*"
				
				''Create the flat pattern
				'oDoc.Unfold()
				'Try
				''exit the flatpattern environment, Try statements is necessary because part might not be in flatpattern mode.
				'oSMDef.FlatPattern.ExitEdit
				'Catch
				'End Try
				
				'Goto Calc:
			End If
			

		End If


		'Endoffile:
		End Sub


		Private Sub CheckCustomProp (PropName As String, Value As String, oDoc As Document)
			customPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
			Dim oPropThickness As Inventor.Property
			Try
				oPropThickness = customPropertySet.Item(PropName)
			Catch
				' Assume error means not found
				oPropThickness = customPropertySet.add("", PropName)
			End Try
			
			If Value <> "" Then oPropThickness.Expression = Value
			
			InventorVb.DocumentUpdate()

		End Sub


		
		
Add a value to an array (VBA)
		
		'Function to add one value to an array	
		Function toArray(arr() As String, value As String)
			
			Try
				Dim x As Integer = arr.Count
				ReDim Preserve arr(0 To (x))
				arr(x) = value
				toArray = arr
			Catch
				ReDim arr(0)
				arr(0) = value
				toArray = arr
			End Try

		End Function
		
Parse Filename and folder from complete Path
		
		'Functions to parse Filename and folder from complete Path
		Public Function FileNameFromPath(strFullPath As String) As String
			FileNameFromPath = Right(strFullPath, Len(strFullPath) - InStrRev(strFullPath, "\"))
		End Function
		
		Public Function FileNameFromPathNoExt(strFullPath As String) As String
			Dim FileNameFromPath2 As String = FileNameFromPath(strFullPath)
			FileNameFromPathNoExt = Left(FileNameFromPath2, (InStrRev(FileNameFromPath2, ".")-1))
		End Function

		Public Function FolderFromPath(strFullPath As String) As String
			FolderFromPath = Left(strFullPath, InStrRev(strFullPath, "\"))
		End Function

		
Align drawing views horizontally and vertically by selection of lines. Source: Bart Den Otter
		
		Sub Main()
			Dim oDoc As DrawingDocument
			oDoc = ThisDoc.Document

			Dim oCurve1, oCurve2 As DrawingCurveSegment
			oCurve1 = GetCurve1(oDoc)
			oCurve2 = GetCurve2(oDoc)

			Dim oView1, oView2 As DrawingView 
			oView1 = oCurve1.Parent.Parent
			oView2 = oCurve2.Parent.Parent

			Dim Curve1Point1, Curve1Point2, Curve2Point1, Curve2Point2, View1Point, View2Point As Point2d
			Curve1Point1=oCurve1.StartPoint
			Curve1Point2=oCurve1.EndPoint
			Curve2Point1=oCurve2.StartPoint
			Curve2Point2=oCurve2.EndPoint

			If oView1.Name = oView2.Name Then
				MessageBox.Show("Select lines from different views", "Align view error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
				Exit Sub
			End If

			If (Round((Curve1Point1.X - Curve1Point2.X)*1e8) = 0 And Round((Curve2Point1.X - Curve2Point2.X)*1e8) = 0) Then
				MoveView = Curve1Point1.X - Curve2Point1.X
				oView2Point = oView2.Position
				oView2Point.X = oView2Point.X + MoveView
				oView2.Position = oView2Point
			Else If(Round((Curve1Point1.Y - Curve1Point2.Y)*1e8) = 0 And Round((Curve2Point1.Y - Curve2Point2.Y)*1e8) = 0) Then
				MoveView = Curve1Point1.Y - Curve2Point1.Y
				oView2Point = oView2.Position
				oView2Point.Y = oView2Point.Y + MoveView
				oView2.Position = oView2Point
			Else
				MessageBox.Show("Lines are not horizontal or vertical or not in the same orientation.", "Align view error", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1)
				MsgBox(Curve1Point1.Y - Curve1Point2.Y)
				MsgBox(Curve2Point1.Y - Curve2Point2.Y)
				Exit Sub
			End If
		End Sub
		 
		Private Function GetCurve1(ByVal oDoc As DrawingDocument) As DrawingCurveSegment
			Dim Curve As DrawingCurveSegment
			Curve = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "Select first line to align")
			Return Curve
		End Function
		 
		Private Function GetCurve2(ByVal oDoc As DrawingDocument) As DrawingCurveSegment
			Dim Curve As DrawingCurveSegment
			Curve = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingCurveSegmentFilter, "Select second line to align")
			Return Curve
		End Function
		
A function to check if property exists and otherwise add Custom iProperties to a file
		
		Private Sub CheckSumProp (PropName As String, Value As String, oDoc As Document)
			Dim SumPropertySet As PropertySet 
			SumPropertySet = oDoc.PropertySets.Item("Inventor Summary Information")
			Dim oProp1 As Inventor.Property
			oProp1 = SumPropertySet.Item(PropName)
			If Value <> "" Then oProp1.Expression = Value
			InventorVb.DocumentUpdate()
		End Sub

		Private Sub CheckTrackProp (PropName As String, Value As String, oDoc As Document)
			Dim TrackPropertySet As PropertySet 
			TrackPropertySet = oDoc.PropertySets.Item("Design Tracking Properties")
			Dim oProp1 As Inventor.Property
			oProp1 = TrackPropertySet.Item(PropName)
			If Value <> "" Then oProp1.Expression = Value
			InventorVb.DocumentUpdate()
		End Sub

		Private Sub CheckCustomProp(PropName As String, Value As String, oDoc As Document)
			customPropertySet = oDoc.PropertySets.Item("Inventor User Defined Properties")
			Dim oPropThickness As Inventor.Property
			Try
				oPropThickness = customPropertySet.Item(PropName)
			Catch
				' Assume error means not found
				oPropThickness = customPropertySet.add("", PropName)
			End Try

			If Value <> "" Then oPropThickness.Expression = Value
	
			InventorVb.DocumentUpdate()
		End Sub
		
VBA MACRO to start the ESKD add-in and activate the technical notes command

A macro to turn on and of the "Technical Requirements" dialog box found in the GOST standards of Inventor. Mark Lancaster wrote an Article following my featured post in Cadalyst magazine

This macro is useful because the dialogue can only be used when the GOST standards are on. Some users of Inventor do not want the GOST standards to be always active. The add-in will provide other functionality, like different style weld symbols. This macro will activate the add-in allowing the command to be activated and after the dialogue is closed it will unload the add-in again.

		
		Public Sub Technical_notes()

		' Created by Hoppend (AUG 2015)
		' This VBA MACRO will start the ESKD add-in and activate the technical notes command
		' once the technical notes dialog box is closed, it will unload the ESKD add-in.
		' The library for this technical notes resides in the "Design Data\GOST\technical requirements\*.tr"
		' the .tr files can be edited with a regular text editor.

			Dim app As Application
			Set app = ThisApplication
			Dim oDoc As Document
			Set oDoc =  app.ActiveDocument
		 
			' Turn on the ESKD Add-In.
			Call Activate
		  
			' Get the CommandManager object.
			Dim oCommandMgr As CommandManager
			Set oCommandMgr = ThisApplication.CommandManager

			' Get control definition for the line command.
			Dim oControlDef As ControlDefinition
			Set oControlDef = oCommandMgr.ControlDefinitions.Item("Gost.Command.TechRequirements")
			' Execute the command.
			Call oControlDef.Execute
		   
			' Turn off the ESKD Add-In.
			Call Deactivate
			
			' Update the document.
			app.ActiveDocument.Update

			' update the ribbons by editing a sketch
			Dim oSketch As DrawingSketch
			Dim oSketches As DrawingSketches
			Set oSketches = oDoc.ActiveSheet.Sketches
				For Each oSketch In oSketches
					If oSketch.Name = "Technical Requirements" Then
					oSketch.Edit
					oSketch.ExitEdit
					End If
				Next
		 End Sub


		Public Sub Activate()
			Dim app As Application
			Set app = ThisApplication

			Dim addins As ApplicationAddIns
			Set addins = app.ApplicationAddIns

			' Get the DWF AddIn using its ID
			Dim AddIn As ApplicationAddIn
			Set AddIn = addins.ItemById("{005B21FC-8537-4926-9F57-3A3216C294C3}")
		 
			' Activate AddIn
			If AddIn.Activated = True Then
				Exit Sub
				Else
				AddIn.Activate
			End If
		End Sub

		Public Sub Deactivate()
			Dim app As Application
			Set app = ThisApplication

			Dim addins As ApplicationAddIns
			Set addins = app.ApplicationAddIns

			' Get the DWF AddIn using its ID
			Dim AddIn As ApplicationAddIn
			Set AddIn = addins.ItemById("{005B21FC-8537-4926-9F57-3A3216C294C3}")
		 
			' Activate AddIn
			If AddIn.Activated = False Then
				Exit Sub
				Else
				AddIn.Deactivate
			End If
		End Sub


		
iLogic script to turn visibility off for objects in all files in an assembly

Sometimes simply hiding all work features, sketches and origin planes with the overall settings of Inventor is just not enough. This is Especially the case when viewing files with the Inventor viewer. Inventor viewer will not allow the user to hide these features. These features can obstruct the view of the model.

This Rule will Present the user with a multiple choice input box. After the choice is made the rule will set visibility for the selected object to off.

		
		'This Rule will Present the user with a multiple choice input box. After the choice is made the rule will set visibility for the selected object to off.

		Class ThisRule
			' Setup Progress Bar
			Dim ReferenceCount As Integer
			Dim oStep As Integer
			Dim oMessage As String = "Setting visibility for objects to off"
			Dim oProgressBar As Inventor.ProgressBar
			Dim DocFailed As Integer

		Sub Main()
			'get the active document
			Dim oDoc As Document 
			oDoc = ThisApplication.ActiveDocument

			'check if the rule is run on an Assembly
			Dim Assydoc As AssemblyDocument
			If oDoc.DocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then   
				Assydoc = oDoc
			Else
				MessageBox.Show("Rule needs to be run from Assembly", "Rule: Object visibility")
				Exit Sub
			End If	

			
			'Present user with multiple choice
			Dim Options() As String = {"All", "Only Origin planes", "Work planes and Origin planes", "Axis only", "Work points only", "Sketches only"}
			Result1 = InputListBox("Please select", Options, Options(0), Title := "Object Visibility", ListName := "List")

			'perform actions on basis of multiple choice. First all documents in the assembly are counted, then the objects are turned off whilst the user is presented with a progress bar
			Select Case Result1
				Case options(0)
					CountReferencedDocuments(Assydoc, 4)
					RemoveWorkPlanes(Assydoc)
					RemoveSketches(Assydoc)
					RemoveWorkpoints(Assydoc)
					RemoveAxis(Assydoc)
				Case options(1)
					CountReferencedDocuments(Assydoc, 1)
					RemoveOriginPlanes(Assydoc)
				Case options(2)
					CountReferencedDocuments(Assydoc, 1)
					RemoveWorkPlanes(Assydoc)
				Case options(3)
					CountReferencedDocuments(Assydoc, 1)
					RemoveAxis(Assydoc)
				Case options(4)
					CountReferencedDocuments(Assydoc, 1)
					RemoveWorkpoints(Assydoc)
				Case options(5)
					CountReferencedDocuments(Assydoc, 1)
					RemoveSketches(Assydoc)
			End Select
			
			oProgressBar.Close
			
			'Check if there are any failed files, and show user how many files.
			If DocFailed <> 0 Then
				MessageBox.Show(DocFailed & " Objects failed to set to invisible", "Object Visibility")
			End If
			'Update file
			iLogicVb.UpdateWhenDone = True
		End Sub

		'this sub will count the objects and create the progress bar
		Sub CountReferencedDocuments(Assydoc As AssemblyDocument, Passes As Integer)
			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
					ReferenceCount = ReferenceCount + Passes
				End If
			 Next
			oProgressBar = ThisApplication.CreateProgressBar(False, ReferenceCount, oMessage)
		End Sub

		'This Sub will set visibility for all origin planes to off
		Sub RemoveOriginPlanes (Assydoc As AssemblyDocument)
			For Each oWorkPlane In Assydoc.ComponentDefinition.WorkPlanes
				If oWorkPlane.Name = "XY Plane" Or oWorkPlane.Name = "XZ Plane" Or oWorkPlane.Name = "YZ Plane"
				oWorkPlane.Visible = False
				End If
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oWorkPlane In Partdoc.ComponentDefinition.WorkPlanes
						If oWorkPlane.Name = "XY Plane" Or oWorkPlane.Name = "XZ Plane" Or oWorkPlane.Name = "YZ Plane"
							Try
								oWorkPlane.Visible = False
							Catch
								DocFailed = DocFailed + 1
							End Try
						End If
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all work planes to off
		Sub RemoveWorkPlanes (Assydoc As AssemblyDocument)
			For Each oWorkPlane In Assydoc.ComponentDefinition.WorkPlanes
				oWorkPlane.Visible = False
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oWorkPlane In Partdoc.ComponentDefinition.WorkPlanes
						Try
							oWorkPlane.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all work axis to off
		Sub RemoveAxis (Assydoc As AssemblyDocument)
			For Each oAxes In Assydoc.ComponentDefinition.WorkPlanes
				oAxes.Visible = False
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oAxes In Partdoc.ComponentDefinition.WorkAxes
						Try
							oAxes.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all work points to off
		Sub RemoveWorkpoints (Assydoc As AssemblyDocument)
			For Each oWorkPoint In Assydoc.ComponentDefinition.WorkPoints
				oWorkPoint.Visible = False
			Next

			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oWorkPoint In Partdoc.ComponentDefinition.WorkPoints
						Try
							oWorkPoint.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub

		'This Sub will set visibility for all sketches to off
		Sub RemoveSketches(Assydoc As AssemblyDocument)
			For Each doc As Document In Assydoc.AllReferencedDocuments
				If (doc.DocumentType = DocumentTypeEnum.kPartDocumentObject) And doc.IsModifiable = True Then
				Dim Partdoc As PartDocument = doc
					For Each oSketch In Partdoc.ComponentDefinition.Sketches
						Try
							oSketch.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
					For Each o3DSketch In Partdoc.ComponentDefinition.Sketches3D
						Try
						o3DSketch.Visible = False
						Catch
							DocFailed = DocFailed + 1
						End Try
					Next
				Partdoc.Update()
				End If
				oProgressBar.Message = ("File " & oStep & " of " & ReferenceCount & ", :Procesed ")
				oProgressBar.UpdateProgress
				oStep = oStep +1
			Next
		End Sub


		'Functions to parse Filename and folder from complete Path
		Public Function FileNameFromPath(strFullPath As String) As String
			FileNameFromPath = Right(strFullPath, Len(strFullPath) - InStrRev(strFullPath, "\"))
		End Function

		Public Function FileNameFromPathNoExt(strFullPath As String) As String
			Dim FileNameFromPath2 As String = FileNameFromPath(strFullPath)
			FileNameFromPathNoExt = Left(FileNameFromPath2, (InStrRev(FileNameFromPath2, ".")-1))
		End Function

		Public Function FolderFromPath(strFullPath As String) As String
			FolderFromPath = Left(strFullPath, InStrRev(strFullPath, "\"))
		End Function

		End Class