• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Macro Error

Status
Niet open voor verdere reacties.
Precies.
En dat krijg je dus door de manier waarop je het gebruikt.
 
Trouwens, vbReadWrite heb ik niet, wel vbNormal.
 
Excuus, staat er nu in en zag dat ik bij de 2e de MsgBox in de With had staan. Gelijk gezet, alleen nu krijg ik 5 keer beide MsgBoxen.

hier de nieuwe code:
Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Select Case ThisWorkbook.BuiltinDocumentProperties("Last Author")  'Controle of je schrijfbevoegd bent
        Case "Gierman, Frank", _
        "Laurman, Kees", _
        "Extra naam"
            Select Case MsgBox("Meneer Laurman, wil je het bestand opslaan voordat je het sluit?", vbYesNoCancel, "Opslaan")  '3 keuze box openen, "Ja/Nee/Annuleren"
            
            Case Is = vbYes 'Wanneer "Ja", opslaan op de locaties hieronder
            
                Dim Origname As String
                                                              
                    Application.DisplayAlerts = False
                    Sheets("Onderhoudsplan 2018").Protect Password:="Wachtwoord", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
                    
                            ActiveWorkbook.SaveAs "I:\TDWerk-Teamleiders\TD MNL\" + ActiveWorkbook.Name
                            
                        On Error GoTo 11
                            SetAttr "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name, vbReadWrite 'Maak hier een ReadWrite van
                                ActiveWorkbook.SaveAs "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name
                            SetAttr "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name, vbReadOnly 'Maak hier een ReadOnly van
                            
11:
                            With Sheets("Fouten") 'fout registratie in tabblad fouten
                                rij = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                                .Cells(rij, 1) = Err.Number
                                .Cells(rij, 2) = Err.Description
                                .Cells(rij, 3) = Now()
                                .Cells(rij, 4) = Environ("username")
                            End With
                            MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard Loenen\Onderhoudsschema niet gelukt", vbOKOnly, "Fout"
                            Resume Next
                            
                        On Error GoTo 0
                        On Error GoTo 12
                            SetAttr "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name, vbReadWrite 'Maak hier een ReadWrite van
                                ActiveWorkbook.SaveAs "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name
                            SetAttr "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name, vbReadOnly 'Maak hier een ReadOnly van
                            
12:
                            With Sheets("Fouten") 'fout registratie in tabblad fouten
                                rij = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                                .Cells(rij, 6) = Err.Number
                                .Cells(rij, 7) = Err.Description
                                .Cells(rij, 8) = Now()
                                .Cells(rij, 9) = Environ("username")
                            End With
                            MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard\Onderhoudsplanning (Eerbeek) niet gelukt", vbOKOnly, "Fout"
                            Resume Next
             
                Application.DisplayAlerts = True

                Exit Sub 'Afsluiten bestand na het opslaan
                
                Case Is = vbCancel 'Wanneer "Annuleren", terug naar bestand
                  Cancel = True
                        
                Case Is = vbNo 'Wanneer "Nee", afsluiten zonder opslaan
                  Application.DisplayAlerts = False
                  Application.Quit
            Exit Sub 'Afsluiten "ingeval van gebruiker..."
            End Select
    Exit Sub
    End Select
        
If ThisWorkbook.ReadOnly Then
Select Case MsgBox("Bestand wordt gesloten, opslaan is niet mogelijk! " _
                & vbNewLine & vbNewLine & "Klik Ok om af te sluiten zonder op te slaan." & vbNewLine & "" _
                & vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & "", vbOKCancel, "ReadOnly bestand") 'Igv ReadOnly bestand deze POP-up
                
        Case Is = vbCancel
        Cancel = True
        
        Case Is = vbOK 'Wanneer "Ok", afsluiten zonder opslaan
                  Application.DisplayAlerts = False
                  Application.Quit
End Select
End If

    Select Case MsgBox("Bestand wordt gesloten, opslaan is niet mogelijk! " _
                    & vbNewLine & vbNewLine & "Klik Ok om af te sluiten zonder op te slaan." & vbNewLine & "" _
                    & vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & "", vbOKCancel, "ReadOnly bestand") 'Indien je niet gebruiker ... bent deze POP-up
                    
            Case Is = vbCancel
            Cancel = True
            
            Case Is = vbOK 'Wanneer "Ok", afsluiten zonder opslaan
                      Application.DisplayAlerts = False
                      Application.Quit
    Exit Sub
    End Select
  
End Sub
 
Ik vraag me dan af hoe je daar bij kwam want die komt niet voor in de pagina die ik je gaf met uitleg over het gebruik van SetAttr.
 
Als je altijd 'on error resume next' of 'on error goto' gebruikt, werkt alles/niets.
 
FrankGierman zei:
ik heb geen idee edmoor, daar staat idd vbNormal.
Klik om te vergroten...

ja ik weet het al.
van de week was ik aan het knooien me thet bestand en hij liep toen telkens vast op die eerste regel. toen heb ik hier een daar wat geprobeerd en waarschijnlijk ook dit.

wat bleek, ik had de bestandsnaam aangepast maar omdat in die map nog geen bestand stond met die naam liep de macro hierop vast. hij kan immers geen vbNormal maken van een bestand wat niet bestaat. (ook niet een vbReadWrite natuurlijk maar) ben het denk ik vergeten terug te zetten.

les voor de volgende keer.
 
HSV zei:
Als je altijd 'on error resume next' of 'on error goto' gebruikt, werkt alles/niets.
Klik om te vergroten...

De eerste opslag plaats werkt sowieso, dus het bestand zal altijd opgeslagen worden. om te registreren of de 2e en 3e locatie werken staan deze waarschuwingen en "On Errors" erin.
 
Gebruik 1 On Error afhandeling. Je kan gewoon in een variabele bijhouden in welk gedeelte van de code je zit en dat in tevens in de foutlog vermelden.
 
edmoor zei:
Gebruik 1 On Error afhandeling. Je kan gewoon in een variabele bijhouden in welk gedeelte van de code je zit en dat in tevens in de foutlog vermelden.
Klik om te vergroten...

Ik lees wat je hier hebt getypt en snap wat je bedoeld maar hoe ik dat zou kunnen doen weet ik niet. Houd ik dan ook de verschillende foutmeldingen?
 
Ja, uiteraard, want die haal je uit Err.Number en Err.Description.
Je weet wel hoe je met met variabele moet omgaan en wat dat zijn?
Want je hebt al vanaf het begin deze overbodige regel er in staan:
Dim Origname As String
 
Nou die Dim regel is een overblijfsel van al die codes die ik bij elkaar in heb gezet.

ik ben ondertussen aan het stoeien geweest en heb de Dim erui gehaald en de Resume Next met de MsgBox omgewisseld. Nu krijg ik de MsgBox nog maar 1 keer per OnError. Tevens alle foutmeldingen onder elkaar laten zetten met in kolom 5 Loenen/Eerbeek om de verschillende bestandlocaties te definieren.

Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Select Case ThisWorkbook.BuiltinDocumentProperties("Last Author")  'Controle of je schrijfbevoegd bent
        Case "Gierman, Frank", _
        "Laurman, Kees", _
        "Extra naam"
            Select Case MsgBox("Meneer Laurman, wil je het bestand opslaan voordat je het sluit?", vbYesNoCancel, "Opslaan")  '3 keuze box openen, "Ja/Nee/Annuleren"
            
            Case Is = vbYes 'Wanneer "Ja", opslaan op de locaties hieronder
            
                    Application.DisplayAlerts = False
                    Sheets("Onderhoudsplan 2018").Protect Password:="Wachtwoord", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
                    
                            ActiveWorkbook.SaveAs "I:\TDWerk-Teamleiders\TD MNL\" + ActiveWorkbook.Name
                            
                        On Error GoTo 11
                            SetAttr "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name, vbNormal 'Maak hier een Normal van
                                ActiveWorkbook.SaveAs "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name
                            SetAttr "I:\Management-Dashboard_Loenen\Onderhoudsschema\" + ActiveWorkbook.Name, vbReadOnly 'Maak hier een ReadOnly van
                            
11:
                            With Sheets("Fouten") 'fout registratie in tabblad fouten
                                rij = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                                .Cells(rij, 1) = Err.Number
                                .Cells(rij, 2) = Err.Description
                                .Cells(rij, 3) = Now()
                                .Cells(rij, 4) = Environ("username")
                                .Cells(rij, 5) = "Loenen"
                                
                            End With
                            Resume Next
                            MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard Loenen\Onderhoudsschema niet gelukt", vbOKOnly, "Fout"
                            
                        On Error GoTo 0
                        On Error GoTo 12
                            SetAttr "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name, vbNormal 'Maak hier een Normal van
                                ActiveWorkbook.SaveAs "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name
                            SetAttr "I:\Management-Dashboard\Onderhoudsplanning\" + ActiveWorkbook.Name, vbReadOnly 'Maak hier een ReadOnly van
                            
12:
                            With Sheets("Fouten") 'fout registratie in tabblad fouten
                                rij = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                                .Cells(rij, 1) = Err.Number
                                .Cells(rij, 2) = Err.Description
                                .Cells(rij, 3) = Now()
                                .Cells(rij, 4) = Environ("username")
                                .Cells(rij, 5) = "Eerbeek"
                                
                            End With
                            Resume Next
                            MsgBox "Er ging iets niet goed met opslaan: " & vbNewLine & vbNewLine & "Opslag Management-Dashboard\Onderhoudsplanning (Eerbeek) niet gelukt", vbOKOnly, "Fout"
             
                Application.DisplayAlerts = True

                Exit Sub 'Afsluiten bestand na het opslaan
                
                Case Is = vbCancel 'Wanneer "Annuleren", terug naar bestand
                  Cancel = True
                        
                Case Is = vbNo 'Wanneer "Nee", afsluiten zonder opslaan
                  Application.DisplayAlerts = False
                  Application.Quit
            Exit Sub 'Afsluiten "ingeval van gebruiker..."
            End Select
    Exit Sub
    End Select
        
If ThisWorkbook.ReadOnly Then
Select Case MsgBox("Bestand wordt gesloten, opslaan is niet mogelijk! " _
                & vbNewLine & vbNewLine & "Klik Ok om af te sluiten zonder op te slaan." & vbNewLine & "" _
                & vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & "", vbOKCancel, "ReadOnly bestand") 'Igv ReadOnly bestand deze POP-up
                
        Case Is = vbCancel
        Cancel = True
        
        Case Is = vbOK 'Wanneer "Ok", afsluiten zonder opslaan
                  Application.DisplayAlerts = False
                  Application.Quit
End Select
End If

    Select Case MsgBox("Bestand wordt gesloten, opslaan is niet mogelijk! " _
                    & vbNewLine & vbNewLine & "Klik Ok om af te sluiten zonder op te slaan." & vbNewLine & "" _
                    & vbNewLine & "Klik annuleren en kies 'Opslaan als' om een persoonlijk bestand te maken." & vbNewLine & "", vbOKCancel, "ReadOnly bestand") 'Indien je niet gebruiker ... bent deze POP-up
                    
            Case Is = vbCancel
            Cancel = True
            
            Case Is = vbOK 'Wanneer "Ok", afsluiten zonder opslaan
                      Application.DisplayAlerts = False
                      Application.Quit
    Exit Sub
    End Select
  
End Sub
 
Je gebruikt nog steeds meerdere labels. Dat is overbodig en vergroot de kans op fouten als je verzuimt terug te keren naar waar je zijn moet.
 
ik heb geen idee hoe dat werkt met variabele, zie het wel eens voorbijkomen maar kan er zelf niet iets customs van maken
 
Kijk eens naar het iets uitgebreidere voorbeeld van wat ik eerder plaatste:
Code: 
Sub Test()
    Dim Sectie As String

    On Error GoTo Foutje
    Sectie = "A"
    ActiveWorkbook.SaveCopyAs "A:\a.a"
    
    Sectie = "B"
    ActiveWorkbook.SaveCopyAs "B:\b.b"
    
    Exit Sub
    
Foutje:
    With Sheets("Fouten")
        rij = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(rij, 1) = Err.Number
        .Cells(rij, 2) = Err.Description
        .Cells(rij, 3) = Now()
        .Cells(rij, 4) = Environ("username")
        .Cells(rij, 5) = Sectie
    End With
    MsgBox "Er is iets mis gegaan, gegevens zijn mogelijk niet goed opgeslagen", vbCritical
    Resume Next
End Sub
 
Laatst bewerkt:
top top top!!!

bedankt voor je tijd! begrijp denk ik wel hoe het nu werkt met de string/variabele....

ben er ook achter (denk ik) waarom hij telkens na het doorlopen van deze macro wederom met zijn eigen Excel pop-up kwam voor het opslaan.

er worden natuurlijk wijzigingen aangebracht in het tabblad "fouten".... heb nu de bestandslocatie die zeker lukt (3e) achteraan gezet en hij komt nu niet meer met de pop-up.

ik zal hem op opgelost zetten
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan