Aantal errors (Onderandere een 1004 error bij de TWEEDE keer runnen)

[Nicknero1405]

Goedemiddag.
Ik ben op mijn werk bezig met het programmeren van een VBA script in SolidWorks waarmee ik het volgende stap voor stap kan doen:

- Het script (macro) word geactiveerd in Solidworks.
- Een inputbox word ge-opent waarin je een naam kunt typen
- Het script opent automatisch een excel bestand en gaat in kolom D naar de ingevulde naam zoeken.
- Het script geeft de rij waarin de naam gevonden is terug in een andere string
- Vervolgens kopieert het script de tekst in kolom B in de rij die hij gevonden heeft in punt 3/4
- Nu plakt hij de tekst automatisch in een custom property in Solidworks.

Alles werkt voor 90%, alleen heb ik een aantal foutmeldingen waar ik echt geen raad mee heb.

Hier heb ik het script waar ik tot zover gekomen ben:

Sub main()
Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim oWS As Excel.Worksheet
Dim strartno As String
Dim sConfig As String
Dim retval As Boolean
Dim strRow As Long
Set oExcel = New Excel.Application
Set swApp = CreateObject("SldWorks.Application")
Set part = swApp.ActiveDoc

strModel = InputBox("Vul hier de naam in waar je naar wilt zoeken.")

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

    strRow = WorksheetFunction.Match((strModel), Range("D1:D500"), 1)

strartno = Cells(strRow, 2).Value
MsgBox ("Artiekel 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
End Sub

Ik hoop dat jullie mij met de volgende punten kunnen helpen:

Error 1:
- Als ik de macro voor de tweede keer run, krijg ik de volgende error: Runtime error '1004': Methode 'Range' of Object'_Global' failed.
en de debugger selecteert de volgende regel:

    strRow = WorksheetFunction.Match((strModel), Range("D1:D500"), 1)

Dit blijft zo om en om door gaan, dus eerst werkt het wel, dan niet, dan wel, dan niet etc etc.

Error 2:
- Als het script geen match kan vinden in kolom D geeft hij de volgende error: Runtime error '1004': Eigenschappen van de klasse WorksheetFunction kan niet worden opgehaald.
en opnieuw selecteert de debugger de volgende regel:

    strRow = WorksheetFunction.Match((strModel), Range("D1:D500"), 1)

Ik wil graag hebben dat als er geen match kan worden gevonden hij een message box stuurt met het bericht "Naam niet gevonden in het database." en vervolgens sluit hij de macro af zodat het niet verder uitgevoerd kan worden.

Error 3:
Nouwja, niet echt een error. Maar ik kom er achter dat ondanks mijn script excel op het einde weer moet afsluiten, ik alsnog een aantal EXCEL.EXE in mijn taken beheer terug vind (ctrl alt del)
Ik denk dat dit komt doordat het script excel opstart, maar door een error eindigt VOOR dat hij excel weer afsluit, maar dat weet ik niet zeker.


Alvast bedankt, en ik hoop echt dat ik zo snel mogelijk dit gefixed krijg.

 

[Mark xl]

strRow = WorksheetFunction.Match((strModel), Range("D1:D500"), 1)

Verwijst niet expliciet naar een range object op een bepaald werkblad.
Begin daar eerst eens mee

Bijvoorbeeld:

With Workbooks(MyWorkbook).Sheets(Mysheet)
    strRow = WorksheetFunction.Match((strModel), .Range("D1:D500"), 1)
    strartno = .Range("B" & strRow).Value
End With

Vul bij with je eigen Workbook en sheet in, bijvoorbeeld oWB.sheets("Artikelen")

Verder schrijf je Artikel zonder ie

 

[Nicknero1405]

Bedankt voor je hulp, Ik denk dat ik het begin te begrijpen. Alleen geeft jou code (die ik dus verandert heb naar onderstaande) de volgende foutmelding:

Expected: End of statement.
En hij selecteert "oWB" van de regel uit deze code:

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

 

[Mark xl]

ik denk dat je hier even mee moet verder knoeien en dat je er dan wel komt
error afhandeling voorkomt dat je constant naar de visual basic editor word gestuurd.

Misschien kun je ook overwegen om range.find te gebruiken in plaats van worksheetfunction.index,
maar Index werkt ook.

Succes,
Mark.

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


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

strmodel = InputBox("Vul hier de naam in waar je naar wilt zoeken.")
oExcel.Visible = True

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
        MsgBox strmodel & " is geen geldige artikelnaam", vbExclamation

    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

 

[Nicknero1405]

Sorry voor de late reactie, maar ik kon deze code pas vandaag uit proberen omdat het op mijn werk is, en niet thuis.

Maar alsnog: HARTELIJK BEDANKT!
Dit was echt precies waar ik naar op zoek was.
Het werkt fantastisch, beide fouten zijn nu allebei opgelost:
- error bij tweede/4/6 etc keer proberen
- error bij geen match

=vraag gemankeerd als opgelost=

Thanks.

Edit:
Owja bijna vergeten: Voor de gene die nog niet helemaal duidelijk is dit, Ik denk dat ik het nu wel snap:
Je moet de objects zoals in mijn geval oExcel, oWB en part die je aan het begin gedimt heb terug zetten naar "" (Niets, of Nothing) zodat het hele script zeg maar terug word gezet naar de default stand.
En als je error krijgt als je iets intypt wat niet gevonden kan worden moet je gewoon een error afhanderling toevoegen met de mogelijke error nummers ;P