Copy part of "part name" to "description" iProperties with vba

[jorgen_dahlstrom]

Hi

Wondering if someone could help me with this:

I want to copy just a part of a part name to description field in iProperties.

ex. I save a part with name: 123A001 Motor Assy for example

After save the part number will be "123A001 Motor Assy" in iProperties

I want to cut "Motor Assy" and paste it to description field as following:

Part Number: 123A001

Description: Motor Assy

I manage to copy the whole part name to Description field with following code:

Sub Main()    
    ' Get the active document.
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument

    ' Get the PropertySets object.
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

    ' Get the design tracking property set.
    Dim oPropSet As PropertySet
    Set oPropSet = oPropSets.Item("Design Tracking Properties")

    ' Get the part number iProperty.
    Dim oPartNum_iProp As Property
    Set oPartNum_iProp = oPropSet.Item("Part Number")
   
    ' Get the description iProperty.
    Dim oDesc_iProp As Property
    Set oDesc_iProp = oPropSet.Item("Description")
   
    ' Copy part number to description
    oDesc_iProp.Value = oPartNum_iProp.Value
   
End Sub

...but I can't figure out how to cut the describing text.

FYI there is always space between the partnumber and describing text so maybe that can be used as a separator, however it can also be space in the describing text...

Any one?

/ Jorgen

[ThatWorksForMe]

Sub Main()    
    ' Get the active document.
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument

    ' Get the PropertySets object.
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

    ' Get the design tracking property set.
    Dim oPropSet As PropertySet
    Set oPropSet = oPropSets.Item("Design Tracking Properties")

    ' Get the part number iProperty.
    Dim oPartNum_iProp As Property
    Set oPartNum_iProp = oPropSet.Item("Part Number")
   
    ' Get the description iProperty.
    Dim oDesc_iProp As Property
    Set oDesc_iProp = oPropSet.Item("Description")
   
    ' Copy part number to description
    oDesc_iProp.Value = Replace(oPartNum_iProp.Value, Left(oPartNum_iProp.Value,8), "")
    oPartNum_iProp.Value = Left(oPartNum_iProp.Value,7)

 End Sub

This will work when the number is always 7 signs long. Its not tested. Try it.

[dgreatice · Accepted solution]

Try This,

Public Sub Main()
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
Dim oPropSets As PropertySets
Set oPropSets = oDoc.PropertySets
Dim oPropSet As PropertySet
Set oPropSet = oPropSets.Item("Design Tracking Properties")
Dim oPartNum_iProp As Property
Set oPartNum_iProp = oPropSet.Item("Part Number")

SavedString = Split(oPartNum_iProp.Value, " ")
oPartNum_iProp.Value = SavedString(0)

Dim oDesc_iProp As Property
Set oDesc_iProp = oPropSet.Item("Description")

'Because you use space delimiter , it become " ".
oDesc_iProp.Value = SavedString(1) & " " & SavedString(2)
End Sub

try to save that file 1234_Motor Assy

SavedString = Split(oPartNum_iProp.Value, "_")

SavedString(0) = 1234

SavedString(1) = Motor Assy

[jorgen_dahlstrom]

Thanks, but now I copied the part number to Description field, it should be the otherway around, the descriptions text should be cut and copied to the description field...

But thanks anyway

/Jorgen

[dgreatice]

Hi,

did you try my code?

with "SPLIT" Command

[jorgen_dahlstrom]

Super that worked!!

Thanks alot!

/ Jorgen

[dgreatice]

Beware

If you save tht file with 1234 motor
It will error, because string(2) is nothing
If you save with 1234 nord motor assy
The result of description only "nord motor"

[jorgen_dahlstrom]

Yes I saw that

But couldn't I use "if, else, end if" here to define which string contains information and only write out the ones that have information?

I must say that I am not so familiar in vba so you have to excuse me..

/ Jorgen

[ThatWorksForMe]

The code from dgeatice does the same as my code does but cuts the name if more than 2 spaces are in the name.

I have tested my code and it does what you have described.

[jorgen_dahlstrom]

---

@ThatWorksForMe wrote:

The code from dgeatice does the same as my code does but cuts the name if more than 2 spaces are in the name.

I have tested my code and it does what you have described.

---

Well, your code copies the part number to description.

But the question was how do I keep the part numer in the "part number" field, cut away the description text "Motor Assy" and paste that text into the description field.

And also if there are mor than one space in the text

I must say I am impressed by how quick you responce here..very nice!

/ Jorgen

[jorgen_dahlstrom]

---

@ThatWorksForMe wrote:

The code from dgeatice does the same as my code does but cuts the name if more than 2 spaces are in the name.

I have tested my code and it does what you have described.

---

Hey, I was a little to fast here, yes your code works..

But if the partnumber only contains 6 letters/digits and a description name can you solve that too?

Thanks

[ThatWorksForMe]

Ok, maybe there is an other problem. I dont know. 

However, You have a solution that works for you. That's what the community is for. 😉

 *EDIT*

One moment. 

[ThatWorksForMe · Accepted solution]

 Sub Main()    
    ' Get the active document.
    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument

    ' Get the PropertySets object.
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

    ' Get the design tracking property set.
    Dim oPropSet As PropertySet
    Set oPropSet = oPropSets.Item("Design Tracking Properties")

    ' Get the part number iProperty.
    Dim oPartNum_iProp As Property
    Set oPartNum_iProp = oPropSet.Item("Part Number")
   
    ' Get the description iProperty.
    Dim oDesc_iProp As Property
    Set oDesc_iProp = oPropSet.Item("Description")
   
    ' Copy part number to description
    SavedString = Split(oPartNum_iProp.Value, " ")
    oDesc_iProp.Value = Trim(Replace(oPartNum_iProp.Value, SavedString(0), ""))
    oPartNum_iProp.Value = SavedString(0)

 End Sub

Try this

[jorgen_dahlstrom]

Well, it works when it is 7 letters, but with 6 letters it removes the first letter after the first space

If you understand what I mean.

ex. Part Name: 123456 Test 1 test 2 test 3

Result:

Part Name: 123456

Derscription: est 1 test 2 test 3

/ Jorgen

[ThatWorksForMe]

Yes I found the mistake and made the code above right. Just test it again.

[dgreatice]

I'm propose to use special delimiter

in you example, you use space delimiter.

1234 motor assy.

example if you use "_":

1234_motor assy

part number =1234

description =motor assy

another case:

1234_motor assy_nord

part number :1234

description = motor assy

vendor = nord

It will be easy to extract.

but if still using space delimiter,

first text (SavedText(0)) used for Part Number

and another will be Description.

so we must count first

actually code update like :

Public Sub Main()
Dim oDoc As Document

Dim oPropSets As PropertySets

Dim oPropSet As PropertySet

Dim oPartNum_iProp As Property

Dim oDesc_iProp As Property

Set oDoc = ThisApplication.ActiveDocument
Set oPropSets = oDoc.PropertySets
Set oPropSet = oPropSets.Item("Design Tracking Properties")
Set oPartNum_iProp = oPropSet.Item("Part Number")

Set oDesc_iProp = oPropSet.Item("Description")

SavedString = Split(oPartNum_iProp.Value, " ")

oPartNum_iProp.Value = SavedString(0)

i = 0
For Each Item In SavedString
i = i + 1
Next

If i > 1 Then
For x = 2 To i
CombineString = CombineString & " " & SavedString(x - 1)
Next

CombineString = Trim(CombineString)
oDesc_iProp.Value = CombineString
Else
'Do nothing
End If
End Sub

[jorgen_dahlstrom]

Awsome man..it works!

Thanks alot!

/ Jorgen

[ThatWorksForMe]

No problem. 😉

[dgreatice]

Great,

I'm forgot it can be use Replace

😄

[jorgen_dahlstrom]

Haha..next problem..

How do I run the macro when I save my file?

Can I use iLogic and the event trigger or should I do something else?

/ Jorgen