Bring in files then breaking up the string

Question

I am pulling files from a folder. From these files and using the file names, I am trying to break up the drawing number from the sheet number in separate columns.

I already can get the drawing number and put this into column B. However I cannot get the sheet number and put this into column C.

Examples of the file names include:

LC-94399s102-AG.dwg
LC-91994s8A.DWG
MC-94997sPC1^004441182.dwg
LC-94399s101-R.dwg
LC-94399s25^003687250.dwg

From these the file names would be: 102-AG, 8A, PC1, 101-R, 25,

Sub GetIssued()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object

Dim openPos As Integer
Dim closePos As Integer

Dim sh As Object

Dim drwn, SheetNum

Set objFSO = CreateObject("scripting.FileSystemObject")

r = 14


fle = ThisWorkbook.Sheets("Header Info").Range("D11") &  
"\Design\Substation\CADD\Working\COMM\"

Set objFolder = objFSO.GetFolder(fle)

Set x1Book = ActiveWorkbook 'Using this Activeworkbook
Set sh = x1Book.Sheets("TELECOM") 'Using this particular sheet
With Sheets("TELECOM")
.Range("A14", "I305").ClearContents
For Each objFile In objFolder.Files
On Error Resume Next

If InStr(objFile.Name, "LC-9") > 0 And InStr(objFile.Type, "DWG                 
File") > 0 Then 'PEDs, Single Line, Cable and Wiring, Jumper and     
Interconnection
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = Array(.Cells(r, 9).Value)
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the 
drawing number and placing it here

        '-----------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1

        ElseIf InStr(objFile.Name, "MC-9") > 0 And InStr(objFile.Type, "DWG File") > 0 Then 'Cable List
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = .Cells(r, 9).Value
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here 

        '-----------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1

        ElseIf InStr(objFile.Name, "BMC-") > 0 And InStr(objFile.Type, "Adobe Acrobat Document") > 0 Then 'Bill of Materials
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = .Cells(r, 9).Value
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here 

        '-----------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1

        ElseIf InStr(objFile.Name, "CSR") > 0 And InStr(objFile.Type, "DWG") > 0 Then 'Single Line Diagram
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = .Cells(r, 9).Value
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here

        '---------------------------------------------------------
        'Trying to Insert InstrMacro here
        '------------------------------------------------------------

        r = r + 1
    End If
Next
End With





 Range("A13:F305").HorizontalAlignment = xlCenter
 Range("A1").Select

 End Sub

The marco that I have working can be seen here:

Sub InstrMacro()

Dim openPos As Integer
Dim closePos As Integer

Dim drwn, SheetNum
drwn = Range("E9") ' String to search in the sheet aka: the hot seat


'Performing a test to see if this is a new drawing or not
SheetNum = InStr(drwn, "^")

openPos = InStr(drwn, "s") 'True reguardless of the condition of the drawing

If SheetNum = 0 Then 'Assuming it is a new drawing
closePos = InStr(drwn, ".")
SheetNum = Mid(drwn, openPos + 1, closePos - openPos - 1)
Else

If SheetNum > 0 Then 'Assuming is NOT a new drawing
closePos = InStr(drwn, "^")
SheetNum = Mid(drwn, openPos + 1, closePos - openPos - 1)

End If
End If

Range("G20").Value = SheetNum


End Sub

A picture for this macro can be seen here.

I have tried making a separate macro the runs and can get the sheet number, but it seems that excel is just skipping this step and running through the rest of the program

I would like to put the drawing number in column B and the sheet number in sheet number in column c.

Edit 04/07/2019:

I have a function kudos to Rawrplus. But I am unsure how to include this into my main sub. Can someone give me any insights? Thanks!

r = 14


fle = ThisWorkbook.Sheets("Header Info").Range("D11") &     "\Design\Substation\CADD\Working\COMM\"

Set objFolder = objFSO.GetFolder(fle)

Set x1Book = ActiveWorkbook 'Using this Activeworkbook
Set sh = x1Book.Sheets("TELECOM") 'Using this particular sheet
With Sheets("TELECOM")
.Range("A14", "I305").ClearContents
For Each objFile In objFolder.Files
On Error Resume Next
        If InStr(objFile.Name, "LC-9") > 0 And InStr(objFile.Type, "DWG File") > 0 Then 'PEDs, Single Line, Cable and Wiring, Jumper and Interconnection
        .Cells(r, 9) = objFile.Name 'Testing Purposes
        drwn = Array(.Cells(r, 9).Value)
        .Cells(r, 2) = Left(drwn, InStr(1, drwn, "s") - 1) 'Get the drawing number and placing it here

        '-----------------------------------------------------------
        Call getFileName(drwn)

        '------------------------------------------------------------

        r = r + 1
        End If
Next
End With

are the *"file names"* always preceeded by the letter `s`? If yes, then it is fairly simple — Samuel Hulla, Apr 07 '19 at 21:37
PS. If you add a reference to `FileSystemObject` then you have access to all the methods under `File` with intellisense. See [this post](https://stackoverflow.com/a/5798392/380384) for more details. — John Alexiou, Apr 07 '19 at 23:33

Samuel Hulla · Accepted Answer · 2019-04-07T22:18:56.717

0

This is presuming from the example data you've provided that the:

File name is always preceded with the letter s

and is always trailed by either . or ^

Private Function getFileName(ByVal from As String)

Dim i As Integer
Dim pos As Integer
Dim temp As String

For i = Len(from) To 1 Step -1
    If Mid(from, i, 1) = "s" Then ' first we find rightmost "s"
        pos = i
    End If
Next i

For i = pos + 1 To Len(from)
    If Mid(from, i, 1) = "^" Or Mid(from, i, 1) = "." Then
        Exit For
    End If
    temp = temp + Mid(from, i, 1)
Next i

    getFileName = temp

End Function

Returns the desired result:

edited Apr 07 '19 at 22:18

answered Apr 07 '19 at 21:55

Samuel Hulla

6,617
7
36
70

In hindsight, the second `for loop` would probably be more elegant as a `Do Until` loop, as it would avoid the usage of `GoTo` but oh well.. – Samuel Hulla Apr 07 '19 at 21:58
You want to use “Exit For” (i.e: If Mid(from, i, 1) = "^" Or Mid(from, i, 1) = "." Then Exit For) and avoid both GoTo and the label itself – DisplayName Apr 07 '19 at 22:15
@DisplayName Ah right, forgot that's a thing. Cheers, edited – Samuel Hulla Apr 07 '19 at 22:18
Sorry for my lack of intelligence, but I was trying to incorporate this function into my Sub, but I don't think that I am doing it right... Can you may elaborate on how to include a function into my sub? – RawrRawr7 Apr 07 '19 at 22:45
@ChristopherLee the simplest of uses would be to declare a variable and store the function result into it. `Dim result as String: result = getFileName(Range("B8"))` – Samuel Hulla Apr 07 '19 at 22:51
Obviously, you can for example loop over a range with `for each`, store the results into an array, print them out using `MsgBox` et cetera... There are many possibilities - depends on what you desire. I can edit into my answer a practical example tomorrow morning if you don't mind waiting a bit, as I went to bed already and it would be a chore to write code on the phone – Samuel Hulla Apr 07 '19 at 22:54
@ChristopherLee judging from the fact you accepted the answer, you figured it out already, or do you still require further assistance? :) – Samuel Hulla Apr 08 '19 at 17:53
Nope! I got it figure out! Thanks for your help! – RawrRawr7 Apr 09 '19 at 02:00

score 0 · Answer 2 · answered Apr 07 '19 at 22:09

0

Try this

Function GetShtNum(strng As String) As String
    GetShtNum = Split(Split(Split(strng, ".")(0), "s")(1), "^")(0)
End Function

answered Apr 07 '19 at 22:09

DisplayName

13,283
2
11
19

score 0 · Answer 3 · answered Apr 07 '19 at 23:27

This quick regular expression user defined function will retrieve either the drawing or sheet number depending on the optional argument passed into it.

Option Explicit

Function stripPieces(str As String, Optional pc As Integer = 1)

    Static rgx As Object

    stripPieces = CVErr(xlErrNA)

    If Right(LCase(str), 4) <> ".dwg" Then Exit Function

    If rgx Is Nothing Then Set rgx = CreateObject("VBScript.RegExp")

    With rgx
        .IgnoreCase = False
        Select Case pc
          Case 1
            .Pattern = "[A-Z]{2}\-[0-9]{5}s"
            If .Test(str) Then
                str = .Execute(str).Item(0)
                stripPieces = Left(str, Len(str) - 1)
            End If
          Case 2
            .Pattern = "s[A-Z0-9\-]{2,9}"
            If .Test(str) Then
                str = .Execute(str).Item(0)
                stripPieces = Mid(str, 2)
            End If
          Case Else
            stripPieces = CVErr(xlErrValue)
        End Select
    End With

End Function

'use on worksheet like
=stripPieces($E2, 1)    'for dwg
=stripPieces($E2, 2)    'for sheet

score 0 · Answer 4 · answered Apr 08 '19 at 00:18

I think you are over complicating the problem.

To get this:

Use the code below (make sure you reference the Microsoft Scripting Runtime, as seen in this post):

Public Sub GetDrawingInfo()

    Dim fso As New FileSystemObject

    'Find the folder where the drawings exist
    Dim fld As Folder
    Set fld = fso.GetFolder(ThisWorkbook.Sheets("Header Info").Range("D11") & _
                                            "\Design\Substation\CADD\Working\COMM\")

    ' Set the target cells to fill the table. Mine started at D12
    Dim target As Range
    Set target = Range("D12")

    Dim f As File
    ' this will tell us what row we are in
    Dim count As Long
    count = 0 
    For Each f In fld.Files
        If LCase(fso.GetExtensionName(f.Name)) = "dwg" Then
            ' We found a .dwg file
            count = count + 1
            ' write filename in first column
            target.Cells(count, 1).Value = f.Name
            ' Get filename without extension
            Dim fname As String
            fname = fso.GetBaseName(f.Name)
            ' Split the filename at the "s"
            Dim parts() As String
            parts = Strings.Split(fname, "s", , vbTextCompare)
            ' The fist part is the code? Like LC-94399
            target.Cells(count, 2).Value = parts(0)
            ' Split the second part at the "^"
            parts = Strings.Split(parts(1), "^", , vbTextCompare)
            ' The first part is the drawing number
            ' Set drawing number as text
            target.Cells(count, 3).NumberFormat = "@"
            target.Cells(count, 3).Value = parts(0)
            ' If a second part exists, it is the sheet number
            If UBound(parts) = 1 Then
                target.Cells(count, 4).Value = parts(1)
            End If
        End If
    Next

End Sub

Bring in files then breaking up the string

4 Answers4