On Error Go to Macro

[Jeneroy]

Allen,
Wie kan mij helpen!

Ik heb een macro gemaakt om artikelen in SAP aan te maken. Het werkt prima.
Alleen het aanroepen van “On Error” werkt niet goed.
Als er een Error is dan moet de "Macro Error1" aangeroepen worden. Het probleem is dat deze macro altijd aangeroepen wordt.

Mijn dank is groot

Macro:

Sub Macro1()
'
' Macro1 Macro
'
   Range("AM1").Select
    
'Create variabels

    Dim objExcel
    Dim objSheet, intRow, i
    Set objExcel = GetObject(, "Excel.Application")
    Set objSheet = objExcel.ActiveWorkbook.ActiveSheet
    
'Connect to SAP

    Set Connection = GetObject("SAPGUI").GetScriptingEngine.Children(0)
        Set session = Connection.Children(Connection.Children.Count - 1)

On Error GoTo Error

For i = 2 To objSheet.UsedRange.Rows.Count
     
'Kolommen
Col1 = Trim(CStr(objSheet.Cells(i, 1).Value)) 'ARST
Col2 = Trim(CStr(objSheet.Cells(i, 2).Value)) ' Artikelomschrijving

'MM01 straten / Branche + ARST
session.findById("wnd[0]/tbar[0]/okcd").Text = "/NMM01"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/cmbRMMG1-MBRSH").Key = "S"
session.findById("wnd[0]/usr/cmbRMMG1-MTART").Key = Col1
session.findById("wnd[0]/usr/cmbRMMG1-MTART").SetFocus
session.findById("wnd[0]").sendVKey 0
                     

'view 1
session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP01/ssubTABFRA1:SAPLMGMM:2004/subSUB1:SAPLMGD1:1002/txtMAKT-MAKTX").Text = Col2

'Artikel creeren
session.findById("wnd[0]/tbar[0]/btn[11]").press
                       
                                   
'Artikelnummer vermelden
session.findById("wnd[0]/sbar").DoubleClick
session.findById("wnd[1]/usr/lbl[1,2]").SetFocus
session.findById("wnd[1]/usr/lbl[1,2]").caretPosition = 0
session.findById("wnd[1]").sendVKey 20
session.findById("wnd[2]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[4,0]").Select
session.findById("wnd[2]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[4,0]").SetFocus
session.findById("wnd[2]/tbar[0]/btn[0]").press
Sheets("Blad3").Select
Range("A1").Select
ActiveSheet.Paste
Calculate
Range("B3").Select
Selection.Copy
Sheets("Blad1").Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Artikel niet aangemaakt

Error:    Call Error1

                 Next i            
    MsgBox "Process Completed"          
'
End Sub

Error:

Sub Error1()
'
' Error1 Macro
'
Sheets("Blad1").Select
ActiveCell.Offset(1, 0).Select
ActiveCell.FormulaR1C1 = "Artikel niet aangemaakt"

'
End Sub

 

[OctaFish]

Je bent een regeltje vergeten.

        'Artikel niet aangemaakt
    Next i
    MsgBox "Process Completed"
    Exit Sub
    
Error:        Call Error1

 

[jkpieterse]

Het is geen goed idee om zaken exact hetzelfde te noemen als bestaande sleutelwoorden in VBA of Excel. Bovendien gebruik je GetObject terwijl je al rechtstreeks toegang hebt tot activesheet. Tenslotte moet je na in de foutafhandeling te zijn gekomen er ook weer uit springen middels één van de Resume statements. Dus:

Sub Macro1()
    Range("AM1").Select

    'Create variabels

    Set objSheet = ActiveSheet

    'Connect to SAP

    Set Connection = GetObject("SAPGUI").GetScriptingEngine.Children(0)
    Set session = Connection.Children(Connection.Children.Count - 1)

    On Error GoTo Fout

    For i = 2 To objSheet.UsedRange.Rows.Count

        'Kolommen
        Col1 = Trim(CStr(objSheet.Cells(i, 1).Value))    'ARST
        Col2 = Trim(CStr(objSheet.Cells(i, 2).Value))    ' Artikelomschrijving

        'MM01 straten / Branche + ARST
        session.findById("wnd[0]/tbar[0]/okcd").Text = "/NMM01"
        session.findById("wnd[0]").sendVKey 0
        session.findById("wnd[0]/usr/cmbRMMG1-MBRSH").Key = "S"
        session.findById("wnd[0]/usr/cmbRMMG1-MTART").Key = Col1
        session.findById("wnd[0]/usr/cmbRMMG1-MTART").SetFocus
        session.findById("wnd[0]").sendVKey 0


        'view 1
        session.findById("wnd[0]/usr/tabsTABSPR1/tabpSP01/ssubTABFRA1:SAPLMGMM:2004/subSUB1:SAPLMGD1:1002/txtMAKT-MAKTX").Text = Col2

        'Artikel creeren
        session.findById("wnd[0]/tbar[0]/btn[11]").press


        'Artikelnummer vermelden
        session.findById("wnd[0]/sbar").DoubleClick
        session.findById("wnd[1]/usr/lbl[1,2]").SetFocus
        session.findById("wnd[1]/usr/lbl[1,2]").caretPosition = 0
        session.findById("wnd[1]").sendVKey 20
        session.findById("wnd[2]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[4,0]").Select
        session.findById("wnd[2]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[4,0]").SetFocus
        session.findById("wnd[2]/tbar[0]/btn[0]").press
        Sheets("Blad3").Paste Sheets("Blad3").Range("A1")
        Application.Calculate
        Sheets("Blad3").Range("B3").Copy
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                        :=False, Transpose:=False
        
        'Artikel niet aangemaakt
VerderNaFout:
    Next i
    MsgBox "Process Completed"
    Exit Sub
Fout:
    Error1
    Resume VerderNaFout
End Sub

 

[Jeneroy]

Heel erg bedankt het werkt prima