How can I format value between 2nd and 4th underscore in the file name? - sql

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

Related

VBA VAL forcing a comma (,) instead of a period (.)

Basically, I am writting a small AutoCAD VBA that reads CSV files to run commands.
First, I put the csv into a string array (as it contains characters as well). One array position I need to use as a double for the command (as it requires it).
I though this would be a simple VAL() since it is supposed to keep the period regardlesss of my region.
Any insight is greatly appreciated.
Private Sub CommandButton2_Click()
sfilename = "C:\Users\Patrick.Legault\OneDrive - Cima+\Projects\AutoCAD Styles\" & ComboBox1.Value & ".csv"
Dim sLineFromFile As String
Dim name As String
Dim font As String
Dim height As String
Dim vlineItems() As String
Open sfilename For Input As #1
Do Until EOF(1)
Line Input #1, sLineFromFile
vlineItems = Split(sLineFromFile, ",")
Call add_textstyle(vlineItems)
Loop
Close #1
End Sub
Sub add_textstyle(vlineItems() As String)
'''Patrick Legault 2021-11-15
'''This routine creates new textstyles with height
Dim textStyle As AcadTextStyle
Dim TextColl As AcadTextStyles
Dim newfontstyle As String
Dim fontpath As String
Dim h_long As Double
fontpath = "C:\Users\Patrick.Legault\OneDrive - Cima+\Projects\AutoCAD Styles\Fonts" '''to be changed
Set TextColl = ThisDrawing.TextStyles '''get the textstyles from this drawing
Set textStyle = TextColl.add(vlineItems(1)) '''add new textstyle
textStyle.fontFile = fontpath & "\" & (vlineItems(2)) '''add new font style to textstyle
h_long = CDbl(Val(vlineItems(3))) ''this returns the value with comma
textStyle.height = (h_long)
MsgBox h_long
End Sub
The csv in question is below:
Text,STD,Romans.shx,2.032,Main Text heght and style
Text,MD,Romans.shx,3.048,
Text,LG,Romans.shx,4.064,
Text,BOM TEXT,Romans.shx,1.5875,Text for Bill of Material
Text,BOLD,Bold.shx,5.08,"Custom FortisBC ""SHX file (Bold)"
Text,BOLDFILL,Boldfill.shx,5.08,"Custom FortisBC ""SHX"" file (Boldfill)"
Text,DIM,Romans.shx,0,"Dim used in Dimension Style ""Engineering"""
Text,NAMEPLATE,Romans.shx,6.35,"Use ""bigfont.shx"""

Extract PDF table and insert into Excel

I have a PDF file that contains a table. I want to use Excel-VBA to search just the first column for an array of values. I have a work around solution at the moment. I converted the PDF to a text file and search it like that. The problem is sometimes these values can be found in multiple columns, and I have no way of telling which one it's in. I ONLY want it if it's in the first column.
When the PDF converts to text, it converts it in a way such that there is an unpredictable amount of lines for each piece of information, so I can't convert it back to a table in an excel sheet based on the number of lines (believe me, I tried). The current method searches each line, and if it sees a match, it checks to see if the two strings are the same length. But like I mentioned earlier, (in a rare case but it does happen) there will be a match in a column that is NOT the column I want to search in. So, I'm wondering, is there a way to extract a single column from a PDF? Or even the entire table as it stands?
Public Sub checkNPCClist()
Dim lines As String
Dim linesArr() As String
Dim line As Variant
Dim these As String
lines = Sheet2.Range("F104").Value & ", " & Sheet2.Range("F105").Value & ", " & Sheet2.Range("F106").Value & ", " & Sheet2.Range("F107").Value
linesArr() = Split(lines, ",")
For Each line In linesArr()
If line <> " " Then
If matchlinename(CStr(line)) = True Then these = these & Trim(CStr(line)) & ", "
End If
Next line
If these <> "" Then
Sheet2.Range("H104").Value = Left(these, Len(these) - 2)
Else: Sheet2.Range("H104").Value = "Nope, none."
End If
End Sub
Function matchlinename(lookfor As String) As Boolean
Dim filename As String
Dim textdata As String
Dim textrow As String
Dim fileno As Integer
Dim temp As String
fileno = FreeFile
filename = "C:\Users\...filepath"
lookfor = Trim(lookfor)
Open filename For Input As #fileno
Do While Not EOF(fileno)
temp = textrow
Line Input #fileno, textrow
If InStr(1, textrow, lookfor, vbTextCompare) Then
If Len(Trim(textrow)) = Len(lookfor) Then
Close #fileno
matchlinename = True
GoTo endthis
End If
End If
'Debug.Print textdata
Loop
Close #fileno
matchlinename = False
endthis:
End Function

Excel VBA user defined function to find images in folder (match excel names to folder names of images)

Currently i am using a function to match image names from excel sheet to image folder, but i want one more thing... that if i save image and forget to add its name in excel then it should show me that i forget to add name.
for example if i save 3 images in image folder
16095_1.jpg,16095_2.jpg,16095_3.jpg
and i add image names in excel sheet as
16095_1.jpg,16095_2.jpg
then it should warn me that i forget one image name in excel cell.
my image name format is - 16095_1.jpg,16095_2.jpg
function i am using is...
Function findimage(Path As String, ImageList As String)
Dim results
Dim x As Long
Dim dc 'double comma
results = Split(ImageList, ",")
If Not Right(Path, 1) = "\" Then Path = Path & "\"
For x = 0 To UBound(results)
results(x) = Len(Dir(Path & results(x))) > 0
Next
dc = InStr(ImageList, ",,")
If dc = 0 Then
findimage = Join(results, ",")
Else
findimage = ("Double_comma")
End If
End Function
This function takes a folder path and a variable number of patterns (See MSDN - Parameter Arrays (Visual Basic)). Using the MSDN - Dir Function to iterates over the file names in the folder path and compares them against the patterns with the MSDN - Like Operator (Visual Basic) to count the number of files that match the patterns.
Usage:
getFileCount("C:\Users\Owner\Pictures",".gif",".png")
getFileCount("C:\Users\Owner\Pictures","*.gif"
getFileCount("C:\Users\Owner\Pictures","apple_.gif","banana_.gif", "orange_##.*")
getFileCount("C:\Users\Owner\Pictures","#####_#.gif")
Function getFileCount(DirPath As String, ParamArray Patterns() As Variant) As Integer
Dim MyFile As String
Dim count As Integer, x As Long
If Not Right(DirPath, 1) = "\" Then DirPath = DirPath & "\"
MyFile = Dir(DirPath, vbDirectory)
Do While MyFile <> ""
For x = 0 To UBound(Patterns)
If MyFile Like Patterns(x) Then
count = count + 1
Exit For
End If
Next
MyFile = Dir()
Loop
getFileCount = count
End Function

Excel VBA - MkDir returns "Path not Found" when using variable

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))

Using Access VBA code, how do I replace words in a comment box using table columns to search for a set of words I want replaced?

I want to reference a table in access to replace words in a comment box. I would search for the words in column 1 and replace them with the words in column 2. I'm not sure how to properly name the columns to insert them in a replace function.
Here is an example of code I am trying to use,
Private Sub Replace_Click()
Dim bullet As String
Dim output As String
bullet = commentBox.Value
commentBox.Value = Replace(bullet, [tbl_name].column_name, [tbl_name].column_name)
End Sub
Options to consider:
Open a recordset of the table, loop through records and execute Replace on each value. If value is in string it will be replaced, if it's not in string then nothing happens.
Sub SubAbb()
Dim rs As DAO.Recordset, sStr As String
Set rs = CurrentDb.OpenRecordset("SELECT Word, Abb FROM Words")
sStr = Me.commentBox
Do While Not rs.EOF
sStr = Replace(sStr, rs!Word, rs!Abb)
rs.MoveNext
Loop
Me.commentBox = sStr
End Sub
Split string to an array, loop through array and do a DLookup on table. If abbreviation found, run Replace on the string. However, this presumes string has only words separated by single space, no punctuation or numbers or dates, which will complicate code.
Sub SubAbb()
Dim sStr As String, sAbb As String, sAry As Variant, x As Integer
sStr = Me.commentBox
sAry = Split(sStr, " ")
For x = 0 To UBound(sAry)
sAbb = Nz(DLookup("Abb", "Words", "Word='" & sAry(x) & "'"), "")
If sAbb <> "" Then sStr = Replace(sStr, sAry(x), sAbb)
Next
Me.commentBox = sStr
End Sub