Pulling variable-length strings from file name using VBA

Question

See bottom for replacement code used from answers.

I am working with a spreadsheet that pulls names from a list of files in a directory. The files are named like John Doe 01011980.xlsx and Janey B Deer 02031983.xlsx, therefore the first and last name are of variable length, can but does not always include a middle initial and is followed by a simplified date of birth. Here is the code I am currently using (which does not work) to sort the name out of the file name.

Private Sub nextname_Click()

Dim strDir As String, first As String, last As String, dateofbirth As String, check As String

strDir = Worksheets("Sheet1").Range("A1").Text
strDir = Dir
If strDir = "" Then
    Unload Me
    MsgBox ("I couldn't find any other client files by that name.")
    Exit Sub
End If

check = Left(strDir, InStr(1, strDir, ".xlsx", vbTextCompare) - 10)

''THE ISSUE IS CONTAINED HEREIN
If InStr(1, check, " * ", vbTextCompare) > 0 Then
    first = Trim(Left(check, Len(check) - InStr(1, check, " ", vbTextCompare) - 2))
    last = Trim(Right(check, Len(check) - InStr(1, check, " ", vbTextCompare) - 2))
Else
    first = Trim(Left(check, Len(check) - InStr(1, check, " ", vbTextCompare)))
    last = Trim(Right(check, Len(check) - InStr(1, check, " ", vbTextCompare)))
End If
''END ISSUE

dateofbirth = mid(strDir, Len(strDir) - 12, 2) & "/" & mid(strDir, Len(strDir) - 10, 2) & "/" & mid(strDir, Len(strDir) - 8, 4)

Worksheets("Sheet1").Range("A1") = "C:\filepath\" & strDir

reviewNameUserform.first_Text.Text = first
reviewNameUserform.last_Text.Text = last
reviewNameUserform.dob_Text.Text = dateofbirth

The issue as marked above is in pulling the first and last name out of the file name, most especially when there is a middle initial. Currently it is only using the Else statement to display John and Doe or Janey B and B Deer, when I want it to detect if there is a middle initial and then pull out John and Doe or Janey and Deer. I fiddled around a lot with Left, Right, Mid, and InStr to no avail.

Replaced

check = Left(strDir, InStr(1, strDir, ".xlsx", vbTextCompare) - 10)

''THE ISSUE IS CONTAINED HEREIN
If InStr(1, check, " * ", vbTextCompare) > 0 Then
    first = Trim(Left(check, Len(check) - InStr(1, check, " ", vbTextCompare) - 2))
    last = Trim(Right(check, Len(check) - InStr(1, check, " ", vbTextCompare) - 2))
Else
    first = Trim(Left(check, Len(check) - InStr(1, check, " ", vbTextCompare)))
    last = Trim(Right(check, Len(check) - InStr(1, check, " ", vbTextCompare)))
End If
''END ISSUE

dateofbirth = mid(strDir, Len(strDir) - 12, 2) & "/" & mid(strDir, Len(strDir) - 10, 2) & "/" & mid(strDir, Len(strDir) - 8, 4)

with

If InStr(filename, ".xlsx") = 0 Then
    MsgBox ("There is no file with that extension.")
    'Possibly include code to check for .xlsm or other extensions.
    Exit Sub
ElseIf (Len(filename) - Len(Replace(filename, " ", ""))) < 2 Then
    MsgBox ("File name format does not match expected format. File name format is FIRST M LAST mmddyyyy.xlsx")
    'Possibly include code to check for misnamed files.
    Exit Sub
Else
    filename = strDir
    filename = mid(filename, 1, InStr(filename, ".xlsx") - 1)
    dateofbirth = mid(filename, InStrRev(filename, " ") + 1)
    filename = mid(filename, 1, InStrRev(filename, " ") - 1)

    first = mid(filename, 1, InStr(filename, " ") - 1)
    filename = mid(filename, InStr(filename, " ") + 1)

    last = mid(filename, InStrRev(filename, " ") + 1)
    middlename = Trim(mid(filename, 1, InStr(filename, " ")))
End If

dateofbirth = mid(dateofbirth, 1, 2) & "/" & mid(dateofbirth, 3, 2) & "/" & mid(dateofbirth, 5, 4)

'Preserved for later use.
'namesData = Split(Replace(strDir, ".xlsx", ""), " ")
'first = namesData(0)
'If UBound(namesData) = 3 Then
'    middlename = namesData(1)
'    last = namesData(2)
'    dateofbirth = namesData(3)
'ElseIf UBound(namesData) = 2 Then
'    last = namesData(1)
'    dateofbirth = namesData(2)
'End If

and added

reviewNameUserform.middle_Text.Text = middlename

Do split by space then test first character of each element for number. Use all elements before that one. — findwindow
– findwindow, Commented May 23, 2016 at 18:30

Maximilian Peters · Accepted Answer · 2016-05-23 18:46:30Z

1

Assuming your file names have a similar format all the time, you could try using the following code. filename can be John Doe 01011980.xlsx or Janey B Deer 02031983.xlsx.

If InStr(filename, ".xlsx") = 0 Then
    MsgBox "missing .xlsx"
ElseIf (Len(filename) - Len(Replace(filename, " ", ""))) < 2 Then
    MsgBox "input format seems weird, not enough spaces"
Else
    filename = Mid(filename, 1, InStr(filename, ".xlsx") - 1)
    dateofbirth  = Mid(filename, InStrRev(filename, " ") + 1)
    filename = Mid(filename, 1, InStrRev(filename, " ") - 1)

    first = Mid(filename, 1, InStr(filename, " ") - 1)
    filename = Mid(filename, InStr(filename, " ") + 1)

    last = Mid(filename, InStrRev(filename, " ") + 1)
    middlename = Trim(Mid(filename, 1, InStr(filename, " ")))
End If

The code first removes the .xlsx ending, the takes the birthdate from the end (last space until end), then gets the first name (start until first space), then the family name (last space until end) and whatever is left becomes the middle name.

edited May 23, 2016 at 18:46

answered May 23, 2016 at 18:33

Maximilian Peters

31.8k12 gold badges95 silver badges102 bronze badges

Sign up to request clarification or add additional context in comments.

1 Comment

MCSythera Over a year ago

An excellent way of formatting the file name down, by continuously rededicating a variable to exclude what's being used. I added dateofbirth = mid(dateofbirth, 1, 2) & "/" & mid(dateofbirth, 3, 2) & "/" & mid(dateofbirth, 5, 4) so that it shows up formatted, and this takes the cake. Also allows me to use the middle initial, which I had originally wanted to do but gave up on because of my issues with selecting the right strings out of the file name. No use of arrays too, which I tend to stay away from because they scare me. I don't know why.

Hadi · Accepted Answer · 2016-05-23 18:36:27Z

1

here's a suggestion....

Private Sub nextname_Click()

    Dim strDir As String, first As String, last As String, dateofbirth As String, check As String

    strDir = Worksheets("Sheet1").Range("A1").Text
    strDir = Dir
    If strDir = "" Then
        Unload Me
        MsgBox ("I couldn't find any other client files by that name.")
        Exit Sub
    End If

    check = Left(strDir, InStr(1, strDir, ".xlsx", vbTextCompare) - 10)

    ''THE SOLUTION IS CONTAINED HEREIN
       check = Trim(check)
       first = Split(check, " ")(LBound(Split(check, " ")))
       last = Split(check, " ")(UBound(Split(check, " ")))

    ''END SOLUTION

    dateofbirth = mid(strDir, Len(strDir) - 12, 2) & "/" & mid(strDir, Len(strDir) - 10, 2) & "/" & mid(strDir, Len(strDir) - 8, 4)

    Worksheets("Sheet1").Range("A1") = "C:\filepath\" & strDir

    reviewNameUserform.first_Text.Text = first
    reviewNameUserform.last_Text.Text = last
    reviewNameUserform.dob_Text.Text = dateofbirth

Hope this helps...

answered May 23, 2016 at 18:36

Hadi

1841 silver badge10 bronze badges

2 Comments

MCSythera Over a year ago

This does work, and as simple as it is, I think it works less effectively than the other two answers as far as manipulating the data later on (storing in an array, for example) and my own personal understanding of how it works (that's not your fault). The other two answers account for a middle initial too, which I had originally given up on because of my own lack of experience with pulling strings from a file name, but being given the ability to use it was an extra bonus. A good answer though that does solve the problem.

Hadi Over a year ago

Happy it helped a bit. I was thinking you did not need the middle initial. and also this code could be limited when the last name contains space like in "EL Paso"...

MCSythera · Accepted Answer · 2016-05-24 16:55:04Z

1

using the tip from findwindow, you can use the split function. So, this part of your code:

''THE ISSUE IS CONTAINED HEREIN
If InStr(1, check, " * ", vbTextCompare) > 0 Then
    first = Trim(Left(check, Len(check) - InStr(1, check, " ", vbTextCompare) - 2))
    last = Trim(Right(check, Len(check) - InStr(1, check, " ", vbTextCompare) - 2))
Else
    first = Trim(Left(check, Len(check) - InStr(1, check, " ", vbTextCompare)))
    last = Trim(Right(check, Len(check) - InStr(1, check, " ", vbTextCompare)))
End If
''END ISSUE

will be modified to:

'USING SPLIT
namesData = Split(Replace(strDir,".xlsx","")," ")
first = namesData(0)
If UBound(namesData)=3 Then
    last = namesData(2)
    dateofbirth = namesData(3)
ElseIf UBound(namesData)=2 Then
    last = namesData(1)
    dateofbirth = namesData(2)
End If

edited May 24, 2016 at 16:55

MCSythera

557 bronze badges

answered May 23, 2016 at 18:41

Kellsens

3121 silver badge8 bronze badges

2 Comments

Maximilian Peters Over a year ago

this will crash for filenames like 'JohnDoe 01011980.xlsx'. Better use elseif ubound(namesData) = 2

MCSythera Over a year ago

I tested this out and it works just as well as the code I chose to go with. I just don't like arrays that much, but I can see how it would be useful to have a variable that has all the elements in it all the time. I may come back to this later and use this instead of the other because there is less limitation on the array storage than there is using one variable that gets re-purposed. I also added middlename = namesData(1) to the If statement to pull out the middle initial, which is nice to have.

Collectives™ on Stack Overflow

Pulling variable-length strings from file name using VBA

3 Answers 3

1 Comment

2 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

1 Comment

2 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related