When I need an "useless" temporary object or variable just for a few lines, I would want it to not dirty the Locals window with its presence at least after its use.
So for example I use to replace this code:
Sub test()
Dim strBaseName$, strExtensionName$
Dim oFSO As New Scripting.FileSystemObject
With oFSO
strBaseName = .GetBaseName(ThisWorkbook.FullName)
strExtensionName = .GetExtensionName(ThisWorkbook.FullName)
End With
Stop ' here I unwantedly see oFSO in the Locals window
End Sub
with this:
Sub test()
Dim strBaseName$, strExtensionName$
With New Scripting.FileSystemObject
strBaseName = .GetBaseName(ThisWorkbook.FullName)
strExtensionName = .GetExtensionName(ThisWorkbook.FullName)
End With
Stop ' here the Locals window is clean
End Sub
Is there a way to obtain the same with a variable instead than an object?
Related
I have this task where i need to find some type of hybridshapes and collect them in a listbox
i have done that part, but i need to create it in such a way that when user selects a item from the list box respective hybridshape or object should get selected in catia
here is the image
here is the code
Option Explicit
Dim ODoc As Document
Dim opartdoc As PartDocument
Dim oPart As Part
Dim ohybs As HybridBodies
Dim ohyb As HybridBody
Dim ohybshps As HybridShapes
Dim ohybshp As HybridShape
Dim i As Integer
Dim j As Integer
Private Sub UserForm_Initialize()
Set ODoc = CATIA.ActiveDocument
Set opartdoc = CATIA.ActiveDocument
Set oPart = opartdoc.Part
End Sub
Private Sub ListBtn_Click()
Set ohybs = oPart.HybridBodies
Set ohyb = ohybs.Item("Shapes")
Set ohybshps = ohyb.HybridShapes
For i = 1 To ohybshps.Count
Set ohybshp = ohybshps.Item(i)
ShapeBox.AddItem ohybshp.Name
ShapeBox.Font.Bold = True
ShapeBox.Font.Size = 25
Next
End Sub
Private Sub SelectBtn_Click()
End Sub
i dont know much about listbox handling
how do i create link between items in listbox and objects in catia
thanks
Hi you could add this to your code and try it. Beware your solution is pretty fragile one. You should consider more robust checks for objects validation
The trick lies in ShapeBox.Value in Shapebox click event. The rest is just catia stuff. But this solution is not foolproof because if you have more shapes with same names it might not select the right one. I would prefer creating a collection where you store real object from sets and the passing these objects to selection
Private Sub ShapeBox_Click()
Call opartdoc.Selection.Clear
Call opartdoc.Selection.Add(opartdoc.Part.FindObjectByName(ShapeBox.Value))
End Sub
I am trying to search through a directory for Shortcuts, get the path for the Shortcut, and add those paths to a collection, for later usage. However subsequent calls to Dir() returns the same file over and over again. I have isolated the problem to being caused by calling the Function Getlnkpath defined below. This function I haven't written myself, so I am unsure exactly what is causing this behaviour, or how to fix it.
tempPath = Dir(startPath & "*.lnk")
Do Until tempPath = vbNullString
myCollection.Add Getlnkpath(startPath & tempPath) & "\"
tempPath = Dir()
Loop
Function Getlnkpath(ByVal Lnk As String)
On Error Resume Next
With CreateObject("Wscript.Shell").CreateShortcut(Lnk)
Getlnkpath = .TargetPath
.Close
End With
End Function
It might be safer to
first: collect all links paths
then: collect all link target paths
so that the first collection stays stable whatever the subsequent operations may do (unless they delete some link or some folder...)
moreover I'd suggest to initialize one Wscript.Shell object only and handle all calls to its CreateShortcut() with it, instead of instantiating one object for each link
finally I myself am drifting towards the use of FileSystemObject in lieu of Dir() function, due to problems I sometimes meet with the latter. this at the only expense of adding the reference to Microsoft Scripting Runtime library
for what above I propose the following code:
Option Explicit
Sub main()
Dim startPath As String
Dim myLinkTargetPaths As New Collection, myLinkFilePaths As Collection
startPath = "C:\myPath\"
Set myLinkFilePaths = GetLinksPaths(startPath) 'first get the collection of all links path
Set myLinkTargetPaths = GetLinksTarget(myLinkFilePaths) ' then get the collection of all links TargetPaths
End Sub
Function GetLinksTarget(myLinkFilePaths As Collection) As Collection
Dim myColl As New Collection
Dim element As Variant
With CreateObject("Wscript.Shell")
For Each element In myLinkFilePaths
myColl.Add .CreateShortcut(element).TargetPath & "\"
Next element
End With
Set GetLinksTarget = myColl
End Function
Function GetLinksPaths(startPath As String) As Collection
Dim objFso As FileSystemObject '<~~ requires adding reference to `Microsoft Scripting Runtime` library
Dim objFile As File
Dim objFolder As Folder
Dim myColl As New Collection
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(startPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName(objFile.Path) = "lnk" Then myColl.Add objFile.Path
Next
Set GetLinksPaths = myColl
End Function
instead, should you want to go on with Dir() function then just change the GetLinksPaths() function as follows:
Function GetLinksPaths(startPath As String) As Collection
Dim tempPath As String
Dim myColl As New Collection
tempPath = Dir(startPath & "*.lnk")
Do Until tempPath = vbNullString
myColl.Add startPath & tempPath
tempPath = Dir()
Loop
Set GetLinksPaths = myColl
End Function
BTW: the CreateObject("Wscript.Shell").CreateShortcut(Lnk) method returns and object (either a WshShortcut or a WshURLShortcut one) that doesn't support any Close() method as you have in your Getlnkpath() function. So remove it to remove the necessity of On Error Resume Nextstatement
Looks like you are creating a new .lnk file with your function and your dir command finds that newly created link (that has overwritten the old one) next. Try to use GetShortcut instead of CreateShortcut in your function.
I have a DatePicker control on a worksheet. When I'm in the embedded code for the worksheet, I can access the control's value as follows:
Public Sub showValue()
Debug.Print Me.DTPicker21.value
End Sub
I would like to get the value from a module. Code here:
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.value
End If
Next
End Sub
When I run this, the obj.value triggers this error:
Object doesn't support this property or method
I checked the list of properties for obj using this procedure, and there is no value property. How can I get the date value that's been set in the DatePicker?
I don't know all of the details, but some of the OLEObjects require that you first access their Object property, then you can access other properties. I think the OLEObject serves as a container, then the "sub-object" is the actual object with which you want to interact. For example, if you run the following two lines of code, you will see that the first returns OleObject and the second returns DTPicker:
Debug.Print "Obj: " & TypeName(obj)
Debug.Print "Obj.Object: " & TypeName(obj.Object)
In your case, try the following code change to remove the error(note the Debug line):
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.Object.Value
End If
Next
End Sub
So I'm quite new to VB and I'm just trying to create something that will open up a .txt file then read the first line and output it.
I've put my code below but when I run it I get the error
Object variable or with block variable not set
because of the line
objTXT=objFSO.OpenTextFile("C:\...",ForReading)
Any help, I feel like I'm missing something quite basic.
Private Sub Text_Reader()
Dim objFSO As FileSystemObject
Dim objTXT As TextStream
Dim str$
Set objFSO = New FileSystemObject
objTXT = objFSO.OpenTextFile("C:\...", ForReading)
str = objTXT.ReadLine
MsgBox (str)
End Sub
The problem is not use Set for opening. Try as follow:
Set objTXT = objFSO.OpenTextFile("C:\...", ForReading)
You don't need FileSystemObject to read textfile.
You can do it like that (without any external libraries):
Public Sub readTextFile(filepath As String)
Dim intFile As Integer
Dim text As String
'------------------------------------------------------------------------------------------------------
intFile = VBA.FreeFile()
Open filepath For Input As #intFile
Line Input #intFile, text
Close intFile
Call MsgBox(text)
End Sub
I'm trying to create a recursive function which adds each folder (and subfolders) to a collection of custom objects. My code is working for around 75% of the folders / subfolders but seemingly random ones are being missed from the collection.
Any ideas?
FolderObj is a custom class, the collection I'm adding to is called ToPathList
Option Explicit
Sub RecurseFolderList(Foldername As String)
On Error Resume Next
Dim FSO, NextFolder
Dim OriginalRange As Range
Dim tempFolderObj As FolderObj
Dim i As Integer
i = 1
Set FSO = CreateObject("Scripting.FileSystemObject")
If Err.Number > 0 Then
Exit Sub
End If
If FSO.FolderExists(Foldername) Then
Set NextFolder = FSO.GetFolder(Foldername)
Set FolderArray = NextFolder.subfolders
For Each NextFolder In FolderArray
Set tempFolderObj = New FolderObj
'assign variables to temporary object
With tempFolderObj
.ID = i
.Filename = NextFolder.Name
.path = NextFolder.path
.first3ints = first3Non0Ints(NextFolder.Name)
End With
'add temporary object to colelction
Call ToPathList.Add(tempFolderObj, CStr(i))
i = i + 1
RecurseFolderList (NextFolder)
Next
' Set NextFolder = Nothing
' Set FolderArray = Nothing
End If
Set FSO = Nothing
End Sub
My key (i) was declared inside the function and therefore was being reset to '1' every time the function was recursed.
This resulted in non-unique keys and therefore some items were not being added to the collection.
Thanks to everyone for their help.