How to Parse Imported Data String into Multiple Fields? 2

[ETSMAN]

Problem:
- I import a txt file of a directory scan on a server and need to parse the txt string into 4 fields.
- There can be subdirectories in Fields2-4.
- The first part of the string does have a constant
"x:\Training\CourseReview\Pending Approval"

This is what I would like the end result table to be:
Field1 = Original data string imported (no change)
Field2 = CourseName (will vary)
Field3 = Tab x (will be Tab A-H)
Field4 = FileName (will vary)

Example records:
Ex.1:"x:\Training\CourseReview\Pending Approval\TeachMeCourse\Tab A\Course101.pptx"
Ex.2:"x:\Training\CourseReview\Pending Approval\TeachMeCourse2\TeachMeNow\Tab B\Course001.doc"

Desired record output per examples:
Ex.1:
Field1 (Original Data)= "x:\Training\CourseReview\Pending Approval\TeachMeCourse\Tab A\Course101.pptx"
Field2 (CourseName)= "TeachMeCourse"
Field3 (Tab x)= "Tab A"
Field4 (FileName)= "Course101.pptx"

Ex.2:
Field1 (Original Data)= "x:\Training\CourseReview\Pending Approval\TeachMeCourse2\TeachMeNow\Tab B\Course001.doc"
Field2 (CourseName)= "TeachMeCourse2\TeachMeNow"
Field3 (Tab x)= "Tab B"
Field4 (FileName)= "Course001.doc"

Help is appreciated.

 

[MajP]

Public Function getCourse(strOriginal As Variant) As String
  Dim strCourses() As String
  If Not IsNull(strOriginal) Then
    strCourses = Split(strOriginal, "\")
    Select Case UBound(strCourses)
    Case 6
      getCourse = strCourses(4)
    Case 7
      getCourse = strCourses(4) & "\" & strCourses(5)
    Case Else
      Debug.Print "Invalid format"
    End Select
   End If
End Function
Public Function getDoc(strOriginal As Variant) As String
  Dim strDocs() As String
  If Not IsNull(strOriginal) Then
    strDocs = Split(strOriginal, "\")
    Select Case UBound(strDocs)
    Case 6
      getDoc = strDocs(6)
    Case 7
      getDoc = strDocs(7)
    Case Else
      Debug.Print "Invalid format"
    End Select
   End If
End Function
Public Function getTab(strOriginal As Variant) As String
  Dim strTabs() As String
  If Not IsNull(strOriginal) Then
    strTabs = Split(strOriginal, "\")
    Select Case UBound(strTabs)
    Case 6
      getTab = strTabs(5)
    Case 7
      getTab = strTabs(6)
    Case Else
      Debug.Print "Invalid format"
    End Select
   End If
End Function

in a query

SELECT 
 tblInput.strInput, 
 getCourse([strInput]) AS CourseName, 
 getTab([strInput]) AS Tab, 
 getDoc([strInput]) AS Document
FROM tblInput;

 

[Andrzejek]

Read on Split function in VBA

Example:

Dim x

x = Split("x:\Training\CourseReview\Pending Approval\TeachMeCourse\Tab A\Course101.pptx", "\")

Will give you an array of elements:
[tt]
x(0) = "x:"
x(1) = "Training"
x(2) = "CourseReview"
x(3) = "Pending Approval"
x(4) = "TeachMeCourse"
x(5) = "Tab A"
x(6) = "Course101.pptx"
[/tt]
It is easy to deal with the information split(ed) that way

Have fun.

---- Andy

 

[ETSMAN]

Thanks I appreciate both posts. Got to say though I'm a newbe on this stuff soooo be kind

MajP,

My sql statement should look like this correct:
Table = DirScan
strInput = OriginalData (this is the field the data was imported to)

SELECT DirScan.OriginalData, getCourse([OriginalData]) AS CourseName, getTab([OriginalData]) AS Tab, getDoc([OriginalData]) AS Document
FROM DirScan;

- Need a little guidance on implementing the code. I take it I insert into Visual Basic and save...?
thx

 

[MajP]

Yes, drop the code into VBA. The sql looks correct.

 

[ETSMAN]

Very cooool. Starting to get close.

When I validate the results if there are any subdirectories after ...\Tab x\ then all fields except original are blank for those records.

ex.
"x:\Training\CourseReview\Pending Approval\TeachMeCourse2\TeachMeNow\Tab B\~Archived\Course000.doc"

Getting there, I can see the light at the end of the tunnel.

thx for all of your help.

 

[MajP]

I missed the par about subdirectories. Makes the problem more complicated

There is no way to determine where the course end and the folder begins. Unless you have some additional rules.

1) Determining the filename is easy because it is always last
2) Determing the start of the Course is easy because it is the 4th element, but how do you tell where it ends and the folder begins. I will assume it ends when the word "Tab" is shown

 

[ETSMAN]

yes exactly, coursename will end at Tab.

 

[MajP]

Public Function getCourse(strOriginal As Variant) As String
  Dim strCourses() As String
  Dim intCount As Integer
  If Not IsNull(strOriginal) Then
    strCourses = Split(strOriginal, "\")
    For intCount = 4 To UBound(strCourses)
       If Left(strCourses(intCount), 3) = "Tab" Then
         Exit Function
       End If
       If getCourse = "" Then
          getCourse = strCourses(intCount)
       Else
          getCourse = getCourse & "\" & strCourses(intCount)
       End If
    Next intCount
  End If
End Function

Public Function getDoc(strOriginal As Variant) As String
  Dim strDocs() As String
  If Not IsNull(strOriginal) Then
    strDocs = Split(strOriginal, "\")
    getDoc = strDocs(UBound(strDocs))
  End If
End Function

Public Function getTab(strOriginal As Variant) As String
  Dim strTabs() As String
  Dim intCount As Integer
  If Not IsNull(strOriginal) Then
    strTabs = Split(strOriginal, "\")
    For intCount = LBound(strTabs) To UBound(strTabs)
       If Left(strTabs(intCount), 3) = "Tab" Then
        getTab = strTabs(intCount)
        Exit Function
      End If
    Next intCount
  End If
End Function

getDoc looks for the last item
getTab looks for the first item starting with TAB
getCourse starts at the 4th item and goes until it hits tab.

 

[ETSMAN]

got it.

so on the 4th item, file, the code will start from right to left end at Tab then start to populate from that point to right to left to end of string. any subdirectories after tab will be captured in 4th item?

if so that would be fine.

 

[ETSMAN]

thanks for all of your help, I'll look it over this week end and check the output.

If I run into anything I'll catch up w/ u on Mon.

thanks again.

 

[MajP]

x:\Training\CourseReview\Pending Approval\TeachMeCourse2\TeachMeNow\Tab B\Course001.doc"

currently getTab only returns the tab not the subdirectory. Which do you want?
Just Tab B
or
Tab B\~Archived\

 

[ETSMAN]

It would be fine if the result was as shown below. If u worked backwards from lft to right for the 4th item and a subdirectory existed after tab and I get:

...Tab x\ ~Archived\filename.ext

if no subdirectory:

...Tab x\ filename.ext

 

[MajP]

Public Function getTab(strOriginal As Variant) As String
  Dim strTabs() As String
  Dim intCount As Integer
  Dim startTab As Integer
  If Not IsNull(strOriginal) Then
    strTabs = Split(strOriginal, "\")
    'find the start
    For intCount = LBound(strTabs) To UBound(strTabs)
       If Left(strTabs(intCount), 3) = "Tab" Then
          startTab = intCount
          Exit For
       End If
    Next intCount
    For intCount = startTab To UBound(strTabs) - 1
      If getTab = "" Then
        getTab = strTabs(intCount)
      Else
        getTab = getTab & "\" & strTabs(intCount)
      End If
    Next intCount
  End If
End Function

replace with this.

It returns everything from Tab to the document name. If you want to include the document name as well change
UBound(strTabs) - 1
with
UBound(strTabs)

 

[ETSMAN]

Wow, this works great...

I guess I'm at my wish list point now:

1. I want to be able to create a report off this query that tells me if I have no files under a Tab (gap report).
Any Tab directory that has no files would show

CourseName Tab x

2. I need to duplicate the "Document" field created by the query and manually modify entries of file names so I can create a report that tells me where I have the same file being reused under various "CourseName" areas for updates(problem is files are managed by different people and one may name a file w/ as: "1.presentation101.pptx" and someone else may name the same file as: "presentation101.pptx"). The only way to get true duplicates is to manually modify based on experience. Once done then a simple duplicate query on the new Presentation field can be run.

I was able to recreate the "Document" field w/ a field name "Presentation", but since the query is readonly I can't modify the new field.

Open to suggestions. Naming file standards etc. would be great, but we are not there yet.

thx again, everything works great so far.

 

[MajP]

The easiest would be to run a Make table query. Do your updates in the new table. Then run an update query on the presentation field to put your changes in the original table. Make sure the new table has a unique field to link to the original table.

 

[ETSMAN]

sounds good.

How about 1. Tab x w/ no files. can the currrent code be modify to include tabs that have no files?

thx

 

[MajP]

you could verify that the final item has a "." in the 4th (.doc,.mdb.xls) or 5th (.pptx,.accdb) position.

Public Function getDoc(strOriginal As Variant) As String
  Dim strDocs() As String
  Dim tempDoc As String
  If Not IsNull(strOriginal) Then
    strDocs = Split(strOriginal, "\")
    tempDoc = strDocs(UBound(strDocs))
     If Mid(tempDoc, Len(tempDoc) - 4, 1) = "." Or Mid(tempDoc, Len(tempDoc) - 3, 1) = "." Then
      getDoc = tempDoc
    Else
      getDoc = "No File"
    End If
  End If
End Function

If you have a folder name like
MyFolder.2010
This will fail. But there is no other means to differentiate.

 

[ETSMAN]

w/ the code from last post I get a run-time error '5':
Invalid procedure call or argument

debug Highlights:

If Mid(tempDoc, Len(tempDoc) - 4, 1) = "." Or Mid(tempDoc, Len(tempDoc) - 3, 1) = "." Then

 

[MajP]

Try this

Public Function getDoc(strOriginal As Variant) As String
  Dim strDocs() As String
  Dim tempDoc As String
  If Not IsNull(strOriginal) Then
    strDocs = Split(strOriginal, "\")
    tempDoc = Nz(strDocs(UBound(strDocs)), "")
    If Len(tempDoc) > 4 Then
        MsgBox Mid(tempDoc, Len(tempDoc) - 4, 1)
        MsgBox Mid(tempDoc, Len(tempDoc) - 3, 1)
        If Mid(tempDoc, Len(tempDoc) - 4, 1) = "." Or Mid(tempDoc, Len(tempDoc) - 3, 1) = "." Then
         getDoc = tempDoc
       Else
         getDoc = "No File"
       End If
    End If
      getDoc = "No File"
  End If
End Function

This will work as long as you do not have any 1 character file names. (i.e. "x.doc" ,"7.ppt")