6 Replies Latest reply on Feb 16, 2018 4:24 AM by Danny Holpin

    Extract string from file name, add to custom properties

    Danny Holpin

      Hi All,

       

      I'm trying to extract a part number, description and issue number from a file name and add to custom properties. I've managed to manipulate other peoples code so far to get me to this:

      'takes file name as string, removes file extention,
      'asks for number of characters in part no (1st "x" digits)
      'adds "x" characters to part no property
      Dim swApp As SldWorks.SldWorks
      Dim swModel As ModelDoc2
      Dim chars As Integer
      Public desc1 As String
      Public partno As String
      
      
      'Sub main()
      
      
      'Set swApp = Application.SldWorks
      'Set swModel = swApp.ActiveDoc
      
      
      'If swModel.CustomInfo("partno") = vbNullString Then
        '  If swModel.CustomInfo("description") = vbNullString Then
         '    addpartno_descifnotempty
         ' End If
      'Else
      'partno_desc_exist
      'End If
      
      
      'End Sub
      
      
      Sub addpartno_descifnotempty()
      
      
      Set swApp = Application.SldWorks
      Set swModel = swApp.ActiveDoc
      
      
      chars = InputBox("How many charcters is the part number", "Choose legnth of part number")
      '   If chars = "" Then
      '    MsgBox ("User canceled!")
      '  End If
      swModel.AddCustomInfo2 "PartNo", swCustomInfoText, Left(swModel.GetTitle, chars) 'add part no
      
      
      'condition description
      desc1 = Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) 'remove file ext
      desc1 = Right(desc1, Len(desc1) - chars - 1) 'remove chars and space
            
      swModel.AddCustomInfo2 "Description", swCustomInfoText, desc1
      'swModel.AddCustomInfo2 "Issue", swCustomInfoText, issno
      
      
      End Sub
      
      
      Sub partno_desc_exist()
      
      
      Set swApp = Application.SldWorks
      Set swModel = swApp.ActiveDoc
      
      
      partno = (swModel.CustomInfo("partno"))
      desc1 = (swModel.CustomInfo("description"))
      issno = (swModel.CustomInfo("issue"))
      
      
      'MsgBox partno
      frmChkDet.Show
         
                  
      End Sub
      
      
      
      

       

      The problem is that there is quite a bit of variation i.e the part numbers are all different lengths of characters, so i need to ask how long the "PartNo" string is.

      My second problem is that i would like to extract the issue number which is sometimes included and if it is included it could be one of many formats e.g.:

      "1234 iss2 part desc"

      "1234 iss 2 part desc"

      "1234 iss 12 part desc"

      "1234 iss12 part desc"

      I've been experimenting with the IsNumeric function but it doesn't seem to deal with spaces very well?

      You can see that I've also been playing with some other features too that have been commented (') out. Probably best to ignore that!

       

      Any help is greatly appreciated, obviously this is my first VBA project so any tips will be also appreciated (like how do you format the code that you paste here? mine doesn't seem to look like everyone else's?

       

      Thanks in advance!

       

      Dan

        • Re: Extract string from file name, add to custom properties
          Sergio Monti

          Hi Danny,

          Please consider mine as just an idea.

          It's very clever what you've done so far. You could then:

          1) take "iss" off from the string desc1

          2) then check the first character, if it is a space then take it off as well

          3) search for the position of the first space in the string, then extract the issue number and take it off

          4) the remaining string is "Description"

          Hope it helps

          • Re: Extract string from file name, add to custom properties
            Ivana Kolin
            Option Explicit
            'takes file name as string, removes file extention,
            'asks for number of characters in part no (1st "x" digits)
            'adds "x" characters to part no property
            Dim swApp As SldWorks.SldWorks
            Dim swModel As ModelDoc2
            Dim chars As Integer
            Public desc1 As String
            Public partno As String
            Public issno As String
              
              
            Sub addpartno_descifnotempty()
              
              
            Set swApp = Application.SldWorks
            Set swModel = swApp.ActiveDoc
              
            If swModel Is Nothing Then Exit Sub
            
            
            Dim pathName As String
            pathName = swModel.GetPathName
            If pathName = "" Then Exit Sub
            
            
            Dim fileName As String
            fileName = fileExtractName(pathName)
            
            
            Dim splitName() As String
            
            
            splitName = Split(fileName, " ")
            Dim x As Integer
            x = UBound(splitName)
            partno = splitName(0)
            
            
            Dim i As Integer
            Dim issCounter As Integer
            For i = 1 To x - 1
                If LCase(splitName(i)) = "iss" Then
                    issno = splitName(i + 1)
                    issCounter = i + 1
                    Exit For
                End If
                If LCase(splitName(i)) Like "iss*" Then
                    issno = Replace(LCase(splitName(i)), "iss", "")
                    issCounter = i
                    Exit For
                End If
            Next
            
            
            For i = issCounter + 1 To x
                desc1 = desc1 & splitName(i) & " "
            Next
            
            
            desc1 = Trim(desc1)
            
            
            swModel.AddCustomInfo2 "PartNo", swCustomInfoText, partno 'add part no
            swModel.AddCustomInfo2 "Description", swCustomInfoText, desc1
            swModel.AddCustomInfo2 "Issue", swCustomInfoText, issno
              
              
            End Sub
              Public Function fileExtractName(ByVal fileName As String) As String
                Dim s                                         As String
                s = fileRemovePath(fileRemoveExtention(fileName))
                fileExtractName = s
            End Function
            Public Function fileRemovePath(ByVal fileName As String) As String
                Dim s                                         As String
                Dim p                                         As Long
                p = InStrRev(fileName, "\")
                If p > 0 Then
                    s = Right(fileName, Len(fileName) - p)
                Else
                    s = fileName
                End If
                fileRemovePath = s
            End Function
            Public Function fileRemoveExtention(ByVal fileName As String) As String
                Dim s                                         As String
                Dim p                                         As Long
                p = InStrRev(fileName, ".")
                If p > 0 Then
                    s = Left(fileName, p - 1)
                Else
                    s = fileName
                End If
                fileRemoveExtention = s
            End Function