I have a function that looks like
Dim arrFold() As String
Dim lastFold As String
arrFold = Split(filePath, "\")
lastFold = arrFold(ubound(arrFold))
I am looking for a way to simplify this into just finding the last element on the first line, rather than having to define an array initially, what can be done to avoid adding that to memory?
debug.print mid(filePath, instrrev(filePath, chr(92))+1)
debug.print trim(right(replace(filePath, chr(92), space(999)), 999))
Sub findLast()
Dim myString As String
myString = "\File\lesser\evenless\least"
MsgBox InStrRev(myString, "\")
End Sub
Related
I have VBA code to capture filenames to a table in an MS Access Database.
The values look like this:
FileName
----------------------------------------------------
WC1603992365_Michael_Cert_03-19-2019_858680723.csv
WC1603992365_John_Non-Cert_03-19-2019_858680722.csv
WC1703611403_Paul_Cert_03-27-2019_858679288.csv
Each filename has 4 _ underscores and the length of the filename varies.
I want to capture the value between the 2nd and the 3rd underscore, e.g.:
Cert
Non-Cert
Cert
I have another file downloading program, and it has "renaming" feature with a regular expression. And I set up the following:
Source file Name: (.*)\_(.*)\_(.*)\_(.*)\_\-(.*)\.(.*)
New File Name: \5.\6
In this example, I move the 5th section of the file name to the front, and add the file extension.
For example, WC1603992365_Michael_Cert_03-19-2019_858680723.csv would be saved as 858680723.csv in the folder.
Is there a way that I can use RegEx to capture 3rd section of the file name, and save the value in a field?
I tried VBA code, and searched SQL examples, but I did not find any.
Because the file name length is not fixed, I cannot use LEFT or RIGHT...
Thank you in advance.
One possible solution is to use the VBA Split function to split the string into an array of strings using the underscore as a delimiter, and then return the item at index 2 in this array.
For example, you could define a VBA function such as the following, residing in a public module:
Function StringElement(strStr, intIdx As Integer) As String
Dim strArr() As String
strArr = Split(Nz(strStr, ""), "_")
If intIdx <= UBound(strArr) Then StringElement = strArr(intIdx)
End Function
Here, I've defined the argument strStr as a Variant so that you may pass it Null values without error.
If supplied with a Null value or if the supplied index exceeds the bounds of the array returned by splitting the string using an underscore, the function will return an empty string.
You can then call the above function from a SQL statement:
select StringElement(t.Filename, 2) from Filenames t
Here I have assumed that your table is called Filenames - change this to suit.
This is the working code that I completed. Thank you for sharing your answers.
Public Function getSourceFiles()
Dim rs As Recordset
Dim strFile As String
Dim strPath As String
Dim newFileName As String
Dim FirstFileName As String
Dim newPathFileName As String
Dim RecSeq1 As Integer
Dim RecSeq2 As Integer
Dim FileName2 As String
Dim WrdArrat() As String
RecSeq1 = 0
Set rs = CurrentDb.OpenRecordset("tcsvFileNames", dbOpenDynaset) 'open a recordset
strPath = "c:\in\RegEx\"
strFile = Dir(strPath, vbNormal)
Do 'Loop through the balance of files
RecSeq1 = RecSeq1 + 1
If strFile = "" Then 'If no file, exit function
GoTo ExitHere
End If
FirstFileName = strPath & strFile
newFileName = strFile
newPathFileName = strPath & newFileName
FileName2 = strFile
Dim SubStrings() As String
SubStrings = Split(FileName2, "_")
Debug.Print SubStrings(2)
rs.AddNew
rs!FileName = strFile
rs!FileName68 = newFileName 'assign new files name max 68 characters
rs!Decision = SubStrings(2) 'extract the value after the 3rd underscore, and add it to Decision Field
rs.Update
Name FirstFileName As newPathFileName
strFile = Dir()
Loop
ExitHere:
Set rs = Nothing
MsgBox ("Directory list is complete.")
End Function
Using streamreader to read line by line of a text file. When I get to a certain line (i.e., 123|abc|99999||ded||789), I want to replace ONLY the first empty area with text.
So far, I've been toying with
If sLine.Split("|")(3) = "" Then
'This is where I'm stuck, I want to replace that index with mmm
End If
I want the output to look like this: 123|abc|99999|mmm|ded||789
Considering you already have code determining if the "mmm" string needs to be added or not, you could use the following:
Dim index As Integer = sLine.IndexOf("||")
sLine = sLine.Insert(index + 1, "mmm")
You could split the string, modify the array and rejoin it to recreate the string:
Dim sLine = "123|abc|99999||ded||789"
Dim parts = sLine.Split("|")
If parts(3) = "" Then
parts(3) = "mmm"
sLine = String.Join("|", parts)
End If
I gather that if you find one or more empty elements, you want to replace the first empty element with data and leave the rest blank. You can accomplish this by splitting on the pipe to get an array of strings, iterate through the array and replace the first empty element you come across and exit the loop, and then rejoin your array.
Sub Main()
Dim data As String = "123||abc|99999||ded||789"
Dim parts = data.Split("|")
For index = 0 To parts.Length - 1
If String.IsNullOrEmpty(parts(index)) Then
parts(index) = "mmm"
Exit For
End If
Next
data = String.Join("|", parts)
Console.WriteLine(data)
End Sub
Results:
123|mmm|abc|99999||ded||789
I need to get file name without extension name by VBA. I know ActiveWorkbook.Name property , but if user haves Windows property Hide extensions for known file types turn off, the result of my code will be [Name.Extension]. How can I return only name of Workbook independent of windows property?
I try even ActiveWorkbook.Application.Caption but I can't customize this property.
The answers given here already may work in limited situations, but are certainly not the best way to go about it. Don't reinvent the wheel. The File System Object in the Microsoft Scripting Runtime library already has a method to do exactly this. It's called GetBaseName. It handles periods in the file name as is.
Public Sub Test()
Dim fso As New Scripting.FileSystemObject
Debug.Print fso.GetBaseName(ActiveWorkbook.Name)
End Sub
Public Sub Test2()
Dim fso As New Scripting.FileSystemObject
Debug.Print fso.GetBaseName("MyFile.something.txt")
End Sub
Instructions for adding a reference to the Scripting Library
Simple but works well for me
FileName = ActiveWorkbook.Name
If InStr(FileName, ".") > 0 Then
FileName = Left(FileName, InStr(FileName, ".") - 1)
End If
Using the Split function seems more elegant than InStr and Left, in my opinion.
Private Sub CommandButton2_Click()
Dim ThisFileName As String
Dim BaseFileName As String
Dim FileNameArray() As String
ThisFileName = ThisWorkbook.Name
FileNameArray = Split(ThisFileName, ".")
BaseFileName = FileNameArray(0)
MsgBox "Base file name is " & BaseFileName
End Sub
This gets the file type as from the last character (so avoids the problem with dots in file names)
Function getFileType(fn As String) As String
''get last instance of "." (full stop) in a filename then returns the part of the filename starting at that dot to the end
Dim strIndex As Integer
Dim x As Integer
Dim myChar As String
strIndex = Len(fn)
For x = 1 To Len(fn)
myChar = Mid(fn, strIndex, 1)
If myChar = "." Then
Exit For
End If
strIndex = strIndex - 1
Next x
getFileType = UCase(Mid(fn, strIndex, Len(fn) - x + 1))
End Function
You could always use Replace() since you're performing this on the workbook's Name, which will almost certainly end with .xlsm by virtue of using VBA.
Using ActiveWorkbook per your example:
Replace(Application.ActiveWorkbook.Name, ".xlsm", "")
Using ThisWorkbook:
Replace(Application.ThisWorkbook.Name, ".xlsm", "")
This thread has been very helpful to me lately. Just to extend on the answer by #RubberDuck, the File System Object in the Microsoft Scripting Runtime library is already there to achieve this. Also if you define it as an Object as below, it will save you the hassle of having to enable 'Microsoft Scripting Runtime' in VBA Tools > References:
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Debug.Print fso.GetBaseName(ActiveWorkbook.Name)
In this way it will return name of the ActiveWorkbook without extension.
There is another way by using INSTRREV function as below:
Dim fname As String
fname = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
MsgBox fname
Both will return the same result. Also in both of the methods above, they will retain any full-stops in the file name and only get rid of the last full-stop and the file extension.
To be verbose it the removal of extension is demonstrated for
workbooks.. which now have a variety of extensions .
. a new unsaved Book1 has no ext
. works the same for files
Function WorkbookIsOpen(FWNa$, Optional AnyExt As Boolean = False) As Boolean
Dim wWB As Workbook, WBNa$, PD%
FWNa = Trim(FWNa)
If FWNa <> "" Then
For Each wWB In Workbooks
WBNa = wWB.Name
If AnyExt Then
PD = InStr(WBNa, ".")
If PD > 0 Then WBNa = Left(WBNa, PD - 1)
PD = InStr(FWNa, ".")
If PD > 0 Then FWNa = Left(FWNa, PD - 1)
'
' the alternative of using split.. see commented out below
' looks neater but takes a bit longer then the pair of instr and left
' VBA does about 800,000 of these small splits/sec
' and about 20,000,000 Instr Lefts per sec
' of course if not checking for other extensions they do not matter
' and to any reasonable program
' THIS DISCUSSIONOF TIME TAKEN DOES NOT MATTER
' IN doing about doing 2000 of this routine per sec
' WBNa = Split(WBNa, ".")(0)
'FWNa = Split(FWNa, ".")(0)
End If
If WBNa = FWNa Then
WorkbookIsOpen = True
Exit Function
End If
Next wWB
End If
End Function
I use a macro from my personal.xlsb and run it on both xlsm and xlsx files so a variation on David Metcalfe's answer that I use is
Dim Wrkbook As String
Wrkbook = Replace(Application.ActiveWorkbook.Name, ".xlsx", ".pdf")
Wrkbook = Replace(Application.ActiveWorkbook.Name, ".xlsm", ".pdf")
Here is a solution if you do not want to use FSO.
There were some similar answers before, but here some checks are done to handle multiple dots in name and name without extension.
Function getFileNameWithoutExtension(FullFileName As String)
Dim a() As String
Dim ext_len As Integer, name_len As Integer
If InStr(FullFileName, ".") = 0 Then
getFileNameWithoutExtension = FullFileName
Exit Function
End If
a = Split(ActiveWorkbook.Name, ".")
ext_len = Len(a(UBound(a))) 'extension length (last element of array)
name_len = Len(FullFileName) - ext_len - 1 'length of name without extension and a dot before it
getFileNameWithoutExtension = Left(FullFileName, name_len)
End Function
Sub test1() 'testing the function
MsgBox (getFileNameWithoutExtension("test.xls.xlsx")) ' -> test.xls
MsgBox (getFileNameWithoutExtension("test")) ' -> test
MsgBox (getFileNameWithoutExtension("test.xlsx")) ' -> test
End Sub
strTestString = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
full credit: http://mariaevert.dk/vba/?p=162
So here's the relevant snippet of my code (COPSFolder is a constant defined elsewhere):
Sub CreateReport(ByRef InfoArray() As String)
Dim BlankReport As Workbook
Dim ReportSheet As Worksheet
Dim ProjFolder As String
ProjFolder = COPSFolder & "InProgress\" & InfoArray(3)
If Not Dir(ProjFolder, vbDirectory) = vbNullString Then
Debug.Print ProjFolder
MkDir ProjFolder <-----ERROR 76 HAPPENS HERE
End If
On the line indicated, ProjFolder & "InProgress\" is an existing directory. I'm trying to create a folder within it based on a value in an array of strings.
Here's what boggles me. If I replace "InfoArray(3)" with a string (ex. "12345") it works fine, but trying to use an element in the array will throw the error. The array is defined as a string everywhere it is referenced, and there are no type mismatches elsewhere in the Module.
edit: Public Const COPSFolder As String = "\\ktch163\COPS\"
edit2: here's another weird thing - if I replace InfoArray(3) with Str(InfoArray(3)) it seems towork. What I don't get is that the value of InfoArray(3) is already defined as a string. Also, it adds a space in front of the value. I can use Right(Str(InfoArray(3)), 5) I guess, but would like to figure out what the real issue is here.
edit3: as requested, here's how InfoArray() is populated:
Public Function GetPartInfo(ByRef TextFilePath As String) As String()
'Opens text file, returns array with each element being one line in the text file
'(Text file contents delimited by line break character)
Dim fso As FileSystemObject: Set fso = New FileSystemObject
Dim Info As Variant
Dim txtstream As Object
Dim item as Variant
Debug.Print TextFilePath
Set txtstream = fso.OpenTextFile(TextFilePath, ForReading, False)
GetPartInfo = Split(txtstream.ReadAll, Chr(10))
For Each item In GetPartInfo
item = Trim(item)
Next
End Function
Later on in the code - InfoArray = GetPartInfo(File.Path). (File.Path works fine, no errors when running GetPartInfo
The problem is that you are splitting using Chr(10) This is not removing the spaces. And hence when you are calling ProjFolder = COPSFolder & "InProgress\" & InfoArray(3), you have spaces in InfoArray(3)
You have 3 options
When you are creating the array, remove the spaces there OR
When you are assigning InfoArray = GetPartInfo(File.Path), remove the spaces there OR
Change the line ProjFolder = COPSFolder & "InProgress\" & InfoArray(3) to ProjFolder = COPSFolder & "InProgress\" & Trim(InfoArray(3))
I need an elegant way using VB.Net to iterate through a range of IP addresses when the input will come to my app as a string in this format:
192.168.100.8-10
This range would include 3 addresses:
192.168.100.8, 192.168.100.9, 192.168.100.10.
I found a solution in C# that uses the IP Address class that I could probably convert to VB but it seemed to be way too much code for what I need to do. I could definitely use a bunch of string parsing functions but I was hoping someone already had a simple way of doing this.
Here is a solution. It would be even easier using generic lists...
Dim arrFinalIpList() As String
Dim strIP As String = "192.168.100.8-10"
Dim arrIP() As String = strIP.Split(".")
Dim strPrefix As String = arrIP(0) & "." & arrIP(1) & "." & arrIP(2) & "."
Dim arrMinAndMax() As String = arrIP(3).Split("-")
Dim intCursor As Integer = 0
For intCursor = CInt(arrMinAndMax(0)) To CInt(arrMinAndMax(1))
If arrFinalIpList Is Nothing Then
ReDim arrFinalIpList(0)
arrFinalIpList(0) = strPrefix & intCursor.ToString()
Else
ReDim Preserve arrFinalIpList(arrFinalIpList.Count)
arrFinalIpList(arrFinalIpList.Count - 1) = strPrefix & intCursor.ToString()
End If
Next