Foutmelding bij opslaan vanuit macro indien bestand is aanwezig

[Robert Smidt]

Beste Helpmij'ers,

Ik gebruik een macro voor Excel die een back-up bestand moet aanmaken als er aan een aantal voorwaarden wordt voldaan. Dit werkt allemaal prima alleen wanneer de back-up al bestaat vraagt Excel of het bestand overschreven moet worden of niet. Overschrijven werkt goed, maar wanneer ik aangeef dat deze niets moet doen geeft excel een foutmelding bij de vetgedrukte regel (zie voorbeeld)

Sub opslaan()

Dim pad As String
Dim BestandsNaam As String

Dim strDriveName As String
    strDriveName = [Backupdrive]
    With CreateObject("Scripting.FileSystemObject")
        If Not .DriveExists(strDriveName) Then
            MsgBox strDriveName & "-drive is niet aanwezig. Kies voor een andere (bestaande) drive/schijf of plaats een USB-stick!"
           ElseIf .GetDrive(strDriveName).IsReady Then
            BestandsNaam = Sheets("Persoonlijke instelling").Range("a2").Value & Sheets("Data").Range("K34").Value & ".xlsm"
            pad = [Backupdrive] & "Cashflow Control"

            'Controleren of de juiste map bestaat, zo niet aanmaken
            If Dir(pad, vbDirectory) = "" Then MkDir (pad)

            If Date - Sheets("Data").Range("I34") > 6 Then
                Sheets("Data").Range("K34") = Sheets("Data").Range("K34") + 1
                Sheets("Data").Range("I34") = Date
                ActiveWorkbook.Save
                [B]ActiveWorkbook.SaveAs Filename:=pad & "\" & BestandsNaam[/B]
            End If
            Application.Quit
        Else
            MsgBox strDriveName & "-drive is aanwezig maar is nog niet gereed."
        End If
    End With
End Sub

Graag antwoord wat ik in de code kan wijzigen zodat deze foutmelding niet gegeven wordt.

Een antwoord zie ik met veel belangstelling tegemoet.

Robert

 

[gast0660]

Test

Sub opslaan()
Dim pad As String
Dim BestandsNaam As String
Dim strDriveName As String
[COLOR="#FF0000"]On Error GoTo oops[/COLOR]
    strDriveName = [Backupdrive]
    With CreateObject("Scripting.FileSystemObject")
        If Not .DriveExists(strDriveName) Then
            MsgBox strDriveName & "-drive is niet aanwezig. Kies voor een andere (bestaande) drive/schijf of plaats een USB-stick!"
           ElseIf .GetDrive(strDriveName).IsReady Then
            BestandsNaam = Sheets("Persoonlijke instelling").Range("a2").Value & Sheets("Data").Range("K34").Value & ".xlsm"
            pad = [Backupdrive] & "Cashflow Control"

            'Controleren of de juiste map bestaat, zo niet aanmaken
            If Dir(pad, vbDirectory) = "" Then MkDir (pad)

            If Date - Sheets("Data").Range("I34") > 6 Then
                Sheets("Data").Range("K34") = Sheets("Data").Range("K34") + 1
                Sheets("Data").Range("I34") = Date
                ActiveWorkbook.Save
                ActiveWorkbook.SaveAs Filename:=pad & "\" & BestandsNaam
            End If
            Application.Quit
        Else
            MsgBox strDriveName & "-drive is aanwezig maar is nog niet gereed."
        End If
    End With
[COLOR="#FF0000"]oops:[/COLOR]
End Sub

 

[edmoor]

Zo van je wel ineens alle fouten af en dat is misschien niet de bedoeling. Beter is het om de Dir() functie te gebruiken om te controleren of een bestand al bestaat of niet.

 

[snb]

Zie, zo:

Sub M_snb()
   On Error Resume Next

   c01 = "G"
   ChDrive c01
   If Err.Number <> 0 Then
      c00 = "Drive " & c01 & " not available"
   Else
      c02 = "voorbeeld"
      If Dir(c01 & ": \" & c02, 16) = "" Then
         c00 = "directory " & c01 & ": \" & c02 & " niet aanwezig"
      Else
         ActiveWorkbook.SaveAs pad & "\" & BestandsNaam
      End If
   End If

   If c00 <> "" Then MsgBox c00
End Sub

 

[Robert Smidt]

Allemaal heel erg bedankt.

Even een vraag voor SNB, hoe moet ik jouw code in mijn code toepassen?