Solidworks filename naar een string

[Nicknero1405]

Nou ben ik hier een paar dagen geleden nog fantastisch geholpen door iemand met mijn probleempjes, maar nu loop ik ineens weer tegen een probleem aan wat mij echt helemaal gek maakt:

Ik heb een VBA script voor een macro in solidworks waarmee de bedoeling is dat hij de file name van het bestand wat op dat moment open is opvraagt zonder pad en filesoort (dus niet bijvoorbeeld "C:/documenten" etc of ".doc" erachter.

Ik heb al duizenden websites gezocht met dit soort codes, maar geen van allen schijnt bij mij te werken.

Ik wil graag de filename kunnen opvragen en die plaatsen in de string "strModel" zodra ik die vervolgens weer kan gebruiken voor andere dingen.

Mijn code doet er op zich niet toe, aangezien je die niet nodig hebt om mij te kunnen helpen, maar ik voeg hem toch maar gewoon even toe voor de zekerheid:

Sub main()
Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim oWS As Excel.Worksheet
Dim strartno As String, sConfig As String, noMatch As String
Dim retval As Boolean
Dim strRow As Long
Dim swapp, part
[COLOR="Red"][B]Dim strmodel As SldWorks.ModelDoc2[/B][/COLOR]

Set oExcel = New Excel.Application
Set swapp = CreateObject("SldWorks.Application")
Set part = swapp.ActiveDoc

[COLOR="Red"][B]Set ModelDoc2 = swapp.ActiveDoc
Set strmodel = part.GetTitle
MsgBox (strmodel)[/B][/COLOR]

oExcel.Visible = False

Set oWB = oExcel.Workbooks.Open("file:///\\savas-sbs1\Openbaar\400 Ont\00 Bibliotheek\Tekeningen\Tekeningenlijst op artikel.xlsx")

On Error GoTo Einde:

With oWB.Sheets("Sheet1")
    strRow = WorksheetFunction.Match((strmodel), .Range("D1:D500"), 1)
    strartno = .Range("B" & strRow).Value
End With

On Error GoTo 0

MsgBox ("Artikel code van " & strmodel & " is: " & strartno & " En is te vinden in rij nummer: " & strRow)

    sConfig = ""    'not config specific in this case
    'set all custom defaults
    part.AddCustomInfo3 sConfig, "Artiekelcode", swCustomInfoText, strartno

Excel.Application.DisplayAlerts = False
Excel.Application.Quit

Einde:
'error afhandeling
Select Case Err.Number
    Case 0
    
    Case 1004
        noMatch = MsgBox(strmodel & " bestaat nog niet in het database. Wil je hem zelf toevoegen?", 36)
        If noMatch = 6 Then
        oExcel.Visible = True
        Set oWB = oExcel.Workbooks.Open("file:///\\savas-sbs1\Openbaar\400 Ont\00 Bibliotheek\Tekeningen\Tekeningenlijst op artikel.xlsx")
        End If

    Case Else
        MsgBox "Er is een fout opgetreden" & vbCr & _
               Err.Description & "(" & Err.Number & ")"
        
End Select
'Objects to void
Set oExcel = Nothing
Set oWB = Nothing
Set part = Nothing

End Sub

Het rode gedeelte is mijn gefaalde poging tot het ophalen van de filename met daarbij een message box om te controleren wat de strmodel voor inhoud heeft, maar dan kom ik telkens tot de conclusie dat het gewoon een lege mesage box is (of terwijl, strModel is gewoon helemaal niets...)

 

[Nicknero1405]

Nooit geweten dat dit zo gemakkelijk kon zijn.
Ik was allemaal moeilijk aan het doen met het opzoeken van de filename en path, en vervolgens de path eruit te halen etc

Heb ik net iets gevonden waarmee je met 3 simpele regeltjes de filename kan aanvragen, en het werkt!

Set swapp = CreateObject("SldWorks.Application")
Set part = swapp.ActiveDoc
strFilename = part.GetTitle

MAAARRRRRRRR
Nu komt het:

Mijn volgende stap is dit nog geavanceerder te maken door precies dit te willen doen, maar dan niet met 1 aparte part, maar in een hele assembly (samenstelling met meerdere parts) om daarin van iedere aparte part de naam op te vragen, daarvan de artikel code opvragen en in een custom property plaatsen.
En daar heb ik nou weer een beetje hulp bij nodig, dus ik hoop echt dat één van jullie hier verstand heeft van solidworks, zijn custom properties en VBA.

Groeten,
Nick


P.S. Mijn werkende code voor 1 aparte part nu:

Sub main()
Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim oWS As Excel.Worksheet
Dim strartno As String, sConfig As String, strmodel As String
Dim retval As Boolean
Dim strRow As Long
Dim swapp, part
Dim noMatch As String


Set oExcel = New Excel.Application
Set swapp = CreateObject("SldWorks.Application")
Set part = swapp.ActiveDoc
strFilename = part.GetTitle



oExcel.Visible = False

Set oWB = oExcel.Workbooks.Open("file:///\\savas-sbs1\Openbaar\400 Ont\00 Bibliotheek\Tekeningen\Tekeningenlijst op artikel.xlsx")

On Error GoTo Einde:

With oWB.Sheets("Sheet1")
    strRow = WorksheetFunction.Match((strFilename), .Range("D1:D500"), 1)
    strartno = .Range("B" & strRow).Value
End With

On Error GoTo 0

MsgBox ("Artikel code van " & strFilename & " is: " & strartno & " En is te vinden in rij nummer: " & strRow)

    sConfig = ""    'not config specific in this case
    'set all custom defaults
    part.AddCustomInfo3 sConfig, "Artiekelcode", swCustomInfoText, strartno

Excel.Application.DisplayAlerts = False
Excel.Application.Quit

Einde:
'error afhandeling
Select Case Err.Number
    Case 0
    
    Case 1004
        noMatch = MsgBox(strFilename & " bestaat nog niet in het database. Wil je hem zelf toevoegen?", 36)
        If noMatch = 6 Then
        oExcel.Visible = True
        Set oWB = oExcel.Workbooks.Open("file:///\\savas-sbs1\Openbaar\400 Ont\00 Bibliotheek\Tekeningen\Tekeningenlijst op artikel.xlsx")
        End If

    Case Else
        MsgBox "Er is een fout opgetreden" & vbCr & _
               Err.Description & "(" & Err.Number & ")"
        
End Select
'Objects to void
Set oExcel = Nothing
Set oWB = Nothing
Set part = Nothing

End Sub