VBA - Extract Particular Folder Name from Path - vba

I have the following code but I need to adjust. I want the user to select a particular folder from within a project. Imagine the path "C:\Project\SomeOtherFolder\WINDOW". The below code only fills the text box if the have selected the "WINDOW" folder. I'm just using this as a check for the user, but I actually want the text box to fill with "Project".
Using fb As New FolderBrowserDialog
If fb.ShowDialog = Windows.Forms.DialogResult.OK AndAlso _
(IO.Path.GetFileName(fb.SelectedPath) = "WINDOW") Then
TextBox1.Text = IO.Path.GetFileName(fb.SelectedPath)
Else
Exit Sub
End If
End Using
How can I accomplish this please? Many Thanks!!!

This UDF, should give you what you need. I have created the function to return the name of the folder up from a specific folder location. I have included some optional parameters so you could (if required) change the requirement.
Public Function GetFolderName(FolderPath As String, _
Optional endPath As String = "WINDOW", _
Optional moveUp As Integer = 2) As String
Dim tmpArr() As String, retStr As String
tmpArr = Split(FolderPath, "\")
If InStr(FolderPath, endPath) <> 0 And moveUp <= UBound(tmpArr) Then
retStr = tmpArr(UBound(tmpArr) - moveUp)
End If
GetFolderName = retStr
End Function
So the code walk through. You send in the Path you obtain in the previous step and then you simply call the function as,
TextBox1.Text = GetFolderName(fb.SelectedPath)
'Or - However this is redundant as the Optional Parameters are declared as such by default
TextBox1.Text = GetFolderName(fb.SelectedPath, "WINDOW", 2)
The above would populate your text box as "Project". Hope this helps !

Related

Random assembly / application name everytime the applicaiton is launched VB.NET code

I have been trying to figure out a way to make it so everytime i launch my application it renames the application to a random string.
My application is in VB.NET
This is my frmLogin.vb (i put the code inside same class as login, since login is my start window, didnt know where else to put it)
Code:
Private Shared Sub Main(ByVal args As String())
Const REGISTRY_KEY As String = "HKEY_CURRENT_USER\Prototype"
Const REGISTY_FIRSTRUN As String = "FirstRun"
Const REGISTY_LASTNAME As String = "LastName"
Dim RandomTitle As String = RandomString(RandomShit.[Next](5, 15)) & ".exe"
Try
If Convert.ToInt32(Microsoft.Win32.Registry.GetValue(REGISTRY_KEY, REGISTY_FIRSTRUN, 0)) = 0 Then
Console.Title = RandomTitle
Dim TempPath As String = Convert.ToString(Microsoft.Win32.Registry.GetValue(REGISTRY_KEY, REGISTY_LASTNAME, 0))
If AppDomain.CurrentDomain.FriendlyName <> "RandomShit.exe" Then
File.Delete("RandomShit.exe")
End If
If File.Exists(TempPath) Then
File.Delete(TempPath)
End If
Microsoft.Win32.Registry.SetValue(REGISTRY_KEY, REGISTY_FIRSTRUN, 1, Microsoft.Win32.RegistryValueKind.DWord)
Microsoft.Win32.Registry.SetValue(REGISTRY_KEY, REGISTY_LASTNAME, Directory.GetCurrentDirectory() & "\" + AppDomain.CurrentDomain.FriendlyName, Microsoft.Win32.RegistryValueKind.String)
End If
Finally
End Try
End Sub
I am not sure whether below code completely satisfied your requirement. I hope below works for you to rename an executable file:
File.Move(System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName, Path.Combine(Path.GetDirectoryName(Process.GetCurrentProcess().MainModule.FileName), "randomstring.exe"))

VB.Net | Is there a way to reference a dynamic amount of variables as arguments to function/sub?

I'm trying to pass a dynamic amount of variables to a Sub by using ByRef;
Essentially I'm trying to create a module that I can easily import into my projects and make handling the file saving/loading process automated.
The Sub/Function would take a number of variables as references and then loop through them changing each one's value.
I realize I'm missing a crucial point in how visual basic's syntax works but I haven't been able to figure out what I need to do.
The code I've written for this is:
Public Sub LoadSaveToVars(ByRef KeyNamesAndVars() As Object, ByVal FileLoc As String = "")
If isEven(KeyNamesAndVars.Length) Then
Dim Contents As String = My.Computer.FileSystem.ReadAllText(FileLoc)
Dim isOnName As Boolean = True
Dim CurrentVal As String = ""
For i = 0 To KeyNamesAndVars.Length - 1
If isOnName Then
CurrentVal = GetStringValue(KeyNamesAndVars(i), Contents) 'Get the value of the key with the key name in the array
isOnName = False
Else
KeyNamesAndVars(i) = CurrentVal 'Set the variable referenced in the array to the value
isOnName = True
End If
Next
Else
Throw New ArgumentOutOfRangeException("The key names and variables supplied are not even.", "Error loading to variables!")
End If
End Sub
And here's how I try to use this function:
Dim TestVar1 As String = ""
Dim TestVar2 As String = ""
LoadSaveToVars({"key1", TestVar1, "key2", TestVar2})
To keep this question clean I did not include the other functions, but I did make a poor attempt at drawing what I want to happen: https://gyazo.com/eee34b8dff766401f73772bb0fef981a
In the end, I want TestVar1 to be equal to "val1" and TestVar2 to be equal to "val2" and to be able to extend this to a dynamic number of variables. Is this possible?

Listview - add File type & Last modified Subitems

I'm trying to add "file type" and "last modified" to my Listview when adding items in It same as in Explorer, but I don't find what property should be assigned to SubItem. Here is my code:
For Each MyFile As IO.FileInfo In ItemDirectory.GetFiles
Dim lvi As New ListViewItem
lvi.Tag = mFile.FullName
lvi.Text = mFile.Name
lvi.ImageKey = CacheShellIcon(mFile.FullName)
Listview1.Items.Add(lvi)
lvi.SubItems.Add("File type ??")
lvi.SubItems.Add(mFile.LastAccessTime.ToShortDateString & " " & mFile.LastAccessTime.ToShortTimeString) 'This isn't same as last modified ?
Next
If somebody knows how to do It please let me know, I want to have this in my Details view.
The linked answer provides an all-purpose way to get all the extended properties. With 300+ elements in newer Windows versions it is clearly overkill to fetch them all if you are only interested in one or two. This returns just the file type. A better approach might be to pass a "shopping list" of desired property names.
As before, you need to add a reference to Microsoft Shell Controls and Automation or Microsoft Shell Folder View Router based on your OS version.
Imports Shell32
Imports SHDocVw
Partial Friend Class Shell32Methods
Friend Shared Function GetShellFileProperty(filepath As String, index As Int32) As String
Dim shell As New Shell32.Shell
Dim shFolder As Shell32.Folder
shFolder = shell.NameSpace(Path.GetDirectoryName(filepath))
' get shell data for this file, cast to folder item
Dim shFolderItem = DirectCast(shFolder.Items().Item(Path.GetFileName(filepath)),
Shell32.ShellFolderItem)
If shFolderItem IsNot Nothing Then
Return shFolder.GetDetailsOf(shFolderItem, index)
Else
Return String.Empty
End If
End Function
...
End Class
Usage:
Dim lvi As ListViewItem
Dim fileType As String
For Each f As String In Directory.EnumerateFiles("C:\Temp\ShellTest")
fileType = Shell32Methods.GetShellFileProperty(f, 9)
lvi = New ListViewItem
lvi.Text = Path.GetFileName(f)
lvi.SubItems.Add(fileType)
lvFiles.Items.Add(lvi)
Next
Ideally, you'd want to create an Enum for the properties so the code could avoid magic numbers:
fileType = Shell32Methods.GetShellFileProperty(f, Shell32FileProps.FileType)
As noted elsewhere, the index of the ones >260 or so can change depending on the OS version. That could be easily modified to accept an Enum/Int array and return a list of values so as to prevent iterating all 300+ propertied to get one or three.
For filetype you can use lvi.SubItems.Add(MyFile.Extension)
and for the "last modified" date, of course the last modified! :D
lvi.SubItems.Add(MyFile.LastWriteTime.ToShortDateString)
Last write and last access are not the same ;)
I figured out another solution, I think this one is easier, at least for me :
Public Function ExProperty(filepath As String, PropertyItem As Integer)
Dim arrHeaders As New List(Of String)()
Dim shell As New Shell
Dim rFolder As Folder = shell.[NameSpace](Path.GetDirectoryName(filepath))
Dim rFiles As FolderItem = rFolder.ParseName(Path.GetFileName(filepath))
'I needed only File type so I looped to 2 only (2 is the file type in my case - Windows 10 -
' to see all available properties do a loop
' 0 To Short.MaxValue - 1" and then extract whatever property you like)
For i As Integer = 0 To 2
Dim value As String = rFolder.GetDetailsOf(rFiles, i).Trim()
arrHeaders.Add(value)
Next
Dim DesiredProperty As String
DesiredProperty = arrHeaders.Item(PropertyItem)
Return DesiredProperty
End Function
Usage with Listview just simply (this adds File type subitem):
Listview1_Item.SubItems.Add(ExProperty(filepath, 2))
As in all solutions, a reference to Microsoft Shell Controls and Automation must be set.

How can I check if filename contains a portion of a string in vb.net

I have a userform in 2008 vb express edition. A part number is created from user input via a concat string. I want to then check if a certain portion of the part number exists in the existing file names in a directory. Below is a more detailed explanation.
This is my code for creating a part number from the user input on the form.
L_PartNo.Text = String.Concat(CB_Type.Text, CB_Face.Text, "(", T_Width.Text, "x", T_Height.Text, ")", mount, T_Qty.Text, weep, serv)
I then have the following code to tell the user if the configuration (part no) they just created exists
L_Found.Visible = True
If File.Exists("Z:\Cut Sheets\TCS Products\BLANK OUT SIGN\" & (L_PartNo.Text) & ".pdf") Then
L_Found.Text = "This configuration exists"
Else
L_Found.Text = "This configuration does NOT exist"
End If
This is where I need help. The part no will look like this BX002(30x30)A1SS I want to compare 002(30x30) (just this part of the file name) to all the files in one directory. I want a yes or no answer to the existance and not a list of all matching files. The code below is everything I've tried, not all at the same time.
Dim b As Boolean
b = L_PartNo.Text.Contains(NewFace)
Dim NewFace As String = String.Concat(CB_Face.Text, "(", T_Width.Text, "x", T_Height.Text, ")")
Dim NewFace = L_PartNo.Text.Substring(2, 10)
If filename.Contains(NewFace) Then
lNewFace.Visible = False
Else
lNewFace.Visible = True
End If
The code below was a translation from the answer in C# but it does not work either
Dim contains As Boolean = Directory.EnumerateFiles(path).Any(Function(f) [String].Equals(f, "myfilethree", StringComparison.OrdinalIgnoreCase))
Here's an example of how you can do it without the fancy LINQ and Lambda which seem to be confusing you:
Public Function FileMatches(folderPath As String, filePattern As String, phrase As String) As Boolean
For Each fileName As String In Directory.GetFiles(folderPath, filePattern)
If fileName.Contains(phrase) Then
Return True
End If
Next
Return False
End Function
Or, if you need it to be case insensitive:
Public Function FileMatches(folderPath As String, filePattern As String, phrase As String) As Boolean
For Each fileName As String In Directory.GetFiles(folderPath, filePattern)
If fileName.ToLower().Contains(phrase.ToLower()) Then
Return True
End If
Next
Return False
End Function
You would call the method like this:
lNewFace.Visible = FileMatches(path, "*.pdf", NewFace)
Try this:
lNewFace.Visible = IO.Directory.GetFiles(path, "*.pdf").Where(Function(file) file. _
Substring(2, 10) = NewFace).FirstOrDefault Is Nothing
Consider that the substring function will throw an exception if its arguments exceed the length of the string it is parsing

Extract filename from path [duplicate]

This question already has answers here:
How to extract file name from path?
(16 answers)
Closed 1 year ago.
I need to extract the filename from a path (a string):
e.g.,
"C:\folder\folder\folder\file.txt" = "file" (or even "file.txt" to get me started)
Essentially everything before and including the last \
I've heard of using wildcards in place of Regex (as it's an odd implementation in VBA?) but can't find anything solid.
Cheers in advance.
I believe this works, using VBA:
Dim strPath As String
strPath = "C:\folder\folder\folder\file.txt"
Dim strFile As String
strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
InStrRev looks for the first instance of "\" from the end, and returns the position. Right makes a substring starting from the right of given length, so you calculate the needed length using Len - InStrRev
Thanks to kaveman for the help. Here is the full code I used to remove both the path and the extension (it is not full proof, does not take into consideration files that contain more than 2 decimals eg. *.tar.gz)
sFullPath = "C:\dir\dir\dir\file.txt"
sFullFilename = Right(sFullPath, Len(sFullPath) - InStrRev(sFullPath, "\"))
sFilename = Left(sFullFilename, (InStr(sFullFilename, ".") - 1))
sFilename = "file"
I was looking for a solution without code. This VBA works in the Excel Formula Bar:
To extract the file name:
=RIGHT(A1,LEN(A1)-FIND("~",SUBSTITUTE(A1,"\","~",LEN(A1)-LEN(SUBSTITUTE(A1,"\","")))))
To extract the file path:
=MID(A1,1,LEN(A1)-LEN(MID(A1,FIND(CHAR(1),SUBSTITUTE(A1,"\",CHAR(1),LEN(A1)-LEN(SUBSTITUTE(A1,"\",""))))+1,LEN(A1))))
`You can also try:
Sub filen()
Dim parts() As String
Dim Inputfolder As String, a As String
'Takes input as any file on disk
Inputfolder = Application.GetOpenFilename("Folder, *")
parts = Split(Inputfolder, "\")
a = parts(UBound(parts()))
MsgBox ("File is: " & a)
End Sub
This sub can display Folder name of any file
Here's simpler method: a one-line function to extract only the name — without the file extension — as you specified in your example:
Function getName(pf):getName=Split(Mid(pf,InStrRev(pf,"\")+1),".")(0):End Function
...so, using your example, this:
       MsgBox getName("C:\folder\folder\folder\file.txt")
  returns:
       
For cases where you want to extract the filename while retaining the file extension, or if you want to extract the only the path, here are two more single-line functions:
Extract Filename from x:\path\filename:
Function getFName(pf)As String:getFName=Mid(pf,InStrRev(pf,"\")+1):End Function
Extract Path from x:\path\filename:
Function getPath(pf)As String: getPath=Left(pf,InStrRev(pf,"\")): End Function
Examples:
(Source)
Using Java:
String myPath="C:\folder\folder\folder\file.txt";
System.out.println("filename " + myPath.lastIndexOf('\\'));
I used kaveman's suggestion successfully as well to get the Full File name but sometimes when i have lots of Dots in my Full File Name, I used the following to get rid of the .txt bit:
FileName = Left(FullFileName, (InStrRev(FullFileName, ".") - 1))
You can use a FileSystemObject for that.
First, include a reference for de Microsoft Scripting Runtime (VB Editor Menu Bar > Tools > References).
After that, you can use a function such as this one:
Function Get_FileName_fromPath(myPath as string) as string
Dim FSO as New Scripting.FileSystemObject
'Check if File Exists before getting the name
iF FSO.FileExists(myPath) then
Get_FileName_fromPath = FSO.GetFileName(myPath)
Else
Get_FileName_fromPath = "File not found!"
End if
End Function
File System Objects are very useful for file manipulation, especially when checking for their existence and moving them around. I like to use them early bound (Dim statement), but you can use them late bound if you prefer (CreateObject statement).
'[/vba]
' Keep It Simple
' .. why use FileSystemObject or Split when Left and Mid will do it
' the FSO has some 33 Subs or Functions
that have to be loaded each time it is created.
' and needs the file to exist ... yet is only a bit slower
... under twice time.. some good code in FSO
' conservation is good .. spare a few electrons. ????... save a few millionths of a sec
'Also
' .. why the format of a function that we all seem to use like
'
' .. Function GetAStr(x) as string
' dim extraStr as string
' a lot of work with extraStr..
' that could have been done with the string variable GetAStr
already created by the function
' then .. GetAStr=extraStr to put it in its right place
' .. End Function
Function GetNameL1$(FilePath$, Optional NLess& = 1)
' default Nless=1 => name only
' NLess =2 => xcopya.xls xcopyb.xls xcopy7.xlsm all as xcopy to get find latest version
' Nless = - 4 or less => name with name.ext worka.xlsm
GetNameL1 = Mid(FilePath, InStrRev(FilePath, "") + 1)
GetNameL1 = Left(GetNameL1, InStrRev(GetNameL1, ".") - NLess)
End Function
Function LastFold$(FilePath$)
LastFold = Left(FilePath, InStrRev(FilePath, "") - 1)
LastFold = Mid(LastFold, InStrRev(LastFold, "") + 1)
End Function
Function LastFoldSA$(FilePath$)
Dim SA$(): SA = Split(FilePath, "")
LastFoldSA = SA(UBound(SA) - 1)
End Function
[<vba]