How do you make a string string loop by VBA?

Hello

I'm looking for a way to loop for different values of multiple string  variables to reduce the size of my code !

Thank you for your help.

Hello

I didn't quite understand.

To make a loop, if you know the number of times you want to loop (for example 10), it's either:

- Example 1:

For i = 1 to 10

      YOUR CODE

next i

- Example 2:

Do while i < 10

       YOUR CODE

       i = i + 1

Loop

- Example 2:

Do

       YOUR CODE

       i = i + 1

Loop while i < 10

But if you don't know the number and it's part of a collection, you can use a for each, an example here:

http://help.solidworks.com/2014/English/api/sldworksapi/Get_Components_in_Each_BOM_Table_Row_VB.htm

 

1 Like

With my example that you know well you will understand what I want to do in my opinion, in fact I would like to replace my links, my names of parts, mep and assemblies (in bold) with string variables that I change every time the loop starts until I no longer have a text value!  

Sub main()
        
Set swApp = _
Application.SldWorks

Set Part = swApp.OpenDoc6("xxxxxxxxxxxxx.SLDASM", 2, 0, "", longstatus, longwarnings) 'opening the source assembly'
swApp.ActivateDoc2 'Pot Store Set', False, longstatus 'enable assembly'
Set Part = swApp.ActiveDoc 'activation'


F1. Show 'opening the information window'


Set swAppp = Application.SldWorks 'back to solidworks app'
Set swmodel = swAppp.ActiveDoc 'Assembly Reactivation'
bool = swmodel. Extension.RunCommand(SwCommands.swCommands_SaveAs, "") 'opening the Save As window'
Set Part = swApp.ActiveDoc 'activate the new assembly saved in the new folder'


FilePath = swmodel. GetPathName 'retrieving the link from the assembly'

TitleA = swmodel. GetTitle 'Name retrieval with assembly extension'
TitleAs = Len(TitleA) 'retrieving extension length'
TitleAn = Left(TitleA, TitleAs - 7) 'delete extension'


' ******************************************************************************
' Recording of the piece store pots
' ******************************************************************************

Set Part = swApp.ActiveDoc 'activation'
Set Part = swApp.OpenDoc6("\\xxxxxxxxxxx.sldprt", 1, 0, "", longstatus, longwarnings) 'opening the part'
Set Part = swApp.ActiveDoc 'activation'

swApp.ActivateDoc2 "Pot Tray.sldprt", False, longstatus 'Pot Tray Coin Activation'
Set Part = swApp.ActiveDoc 'activation'

Set swmodel = swApp.ActiveDoc 'mep activation'

TitlePb = swmodel. GetTitle 'retrieval of the title from the mep of the pots store without the extension'

Set Part = swApp.OpenDoc6("xxxxxxxx.SLDDRW", 3, 0, "", longstatus, longwarnings) 'open the mep'
Set Part = swApp.ActiveDoc 'activation'

swApp.ActivateDoc2 "Pots Store - Sheet1", False, longstatus 'mep activation'
Set Part = swApp.ActiveDoc 'activation'

Set swmodel = swApp.ActiveDoc 'activation for doc information'

TitleM = swmodel. GetTitle 'mep title recovery without extension'

Set Part = swApp.ActiveDoc 'activation'

swApp.ActivateDoc2 "Store pots.sldprt", False, longstatus 'part activation'
Set Part = swApp.ActiveDoc 'activation'

Set swAppp = Application.SldWorks 'enable solidworks app'
Set swmodel = swAppp.ActiveDoc 'part activation'
bool = swmodel. Extension.RunCommand(SwCommands.swCommands_SaveAs, "") 'opens the Save As window'

Set swmodel = swApp.ActiveDoc 'mep activation'

TitleM = swmodel. GetTitle 'mep title recovery without extension'

PFilePath = swmodel. GetPathName 'retrieving the link of the part with the extension'
PsFilePath = Len(PFilePath) 'retrieving the length of the part link with the extension'
PnFilePath = Left(PFilePath, PsFilePath - 7) 'removal of extension'
MFilePath = PnFilePath & ". SLDDRW" 'added extension for mep links'

TitleP = swmodel. GetTitle 'retrieval of the title of the jar store room with the extension'
TitlePs = Len(TitleP) 'Extension Length Retrieve'
TitlePn = Left(TitleP, TitlePs - 7) 'delete extension'

Set Part = swApp.ActiveDoc 'activation'
Set Part = Nothing
swApp.CloseDoc TitlePn 'close room'
Set Part = swApp.ActiveDoc 'activation'

swApp.ActivateDoc2 "Pot Store - Sheet1", False, longstatus 'mep activation'
Set Part = swApp.ActiveDoc 'activation'

longstatus = Part.SaveAs3(MFilePath, 0, 2) 'mep record'

Set swmodel = swApp.ActiveDoc 'mep activation'
TitleM = swmodel. GetTitle 'retrieving the title of the new mep without the extension'

swApp.CloseDoc TitleM 'close mep'

swApp.ActivateDoc2 TitlePn, False, longstatus 'back to part'
Set Part = swApp.ActiveDoc 'activation'
Set Part = Nothing
swApp.CloseDoc TitlePn 'close room'
Set Part = swApp.ActiveDoc 'activation'


swApp.ActivateDoc2 TitleAn, False, longstatus 'back to the general assembly (pot store assembly)'
Set Part = swApp.ActiveDoc

Set Part = swApp.ActiveDoc
longstatus = Part.SaveAs3(FilePath, 0, 2) 'General Assembly Record (Pot Store Set)'

Set Part = swApp.ActiveDoc
Set Part = Nothing
swApp.CloseDoc TitleAn 'Closing the General Assembly (Pot Tray Set)'


End Sub

So if I understood correctly, you simply have to replace the code:

Set Part = swApp.OpenDoc6("\\xxxxxxxxxxx.sldprt", 1, 0, "", longstatus, longwarnings) 'opening the part'
 

by:

Set Part = swApp.OpenDoc6(path1, 1, 0, "", longstatus, longwarnings) 'open the part'
'And so on for the others

And your loop you're going to do like this:

for i = 1 to 3      '(3 if you want to loop 3 times)

    if i = 1 then

         path 1 = "c:\test 1\"

    else if i = 2 then

         path 2 = "c:\test 2\"

    else if i = 3 then

         path 3 = "c:\test 3\"

    end if

    Here is the rest of your code that should be included in the loop

next i

    Here is the rest of your code that should NOT be included in the loop

 

1 Like

Subtle! I'll try like this, thank you very much :)

1 Like

No worries:)

To be cleaner you should use a select case instead of:

    if i = 1 then

         path 1 = "c:\test 1\"

    else if i = 2 then

         path 2 = "c:\test 2\"

    else if i = 3 then

         path 3 = "c:\test 3\"

    end if

It would be:

select case i

    Box 1

         path 1 = "c:\test 1\"

    Box 2

......

 

end select