Fout in Worbook_beforeClose

[danny147]

Beste

Ik krijg foutmelding in volgende code:

Private Sub WorkBook_beforeClose(Cancel As Boolean)
Melding = MsgBox("Bent je zeker dat je dit wilt opslaan ?", vbYesNo + vbExclamation, "Afsluiten...")
If Melding = vbYes Then
ActiveWorkbook.SaveAs Filename:

="G:Ploegbazen ELE\Jonas\Uren invullen\"&Year(Now)"&"\"&"Month(Now)"&"\"&"Format(Date,"d-mm-yyyy")"&.xls"
Else
ActiveWorkbook.Close
End Sub

De volledige padnaam =

G:Ploegbazen\Jonas\Uren invullen\2011\december\16-12-2011.xls

Jaar, maand en datum moeten variabel zijn.

Kan iemand de code aanpassen ?

Groetjes Danny :thumb:

 

[Niels28]

Je moet wel even kijken wat je met je origeneel doet, als er voor de save optie gekozen wordt, wordt deze niet afgesloten.
Dat heb ik er nu wel in staan en die wordt dan niet gesaved.

Private Sub WorkBook_beforeClose(Cancel As Boolean)
Melding = MsgBox("Bent je zeker dat je dit wilt opslaan ?", vbYesNo + vbExclamation, "Afsluiten...")
If Melding = vbYes Then
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Year(Now)) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Year(Now) & "\")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Year(Now) & "\" & Month(Now)) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Year(Now) & "\" & Month(Now))
End With

ActiveWorkbook.SaveAs Filename:="G:\Ploegbazen ELE\Jonas\Uren invullen\" & Year(Now) & "\" & Month(Now) & "\" & Format(Date, "d-mm-yyyy") & ".xls"
ActiveWorkbook.Close SaveChanges:=True
End If
ThisWorkbook.Close SaveChanges:=False
End Sub

PS ik heb het niet getest

Niels

 

[danny147]

Beste Niels28

Nog steeds foutmelding op volgende regel:

ActiveWorkbook.SaveAs Filename:="G:\Ploegbazen ELE\Jonas\Uren invullen\" & Year(Now) & "\" & Month(Now) & "\" & Format(Date, "d-mm-yyyy") & ".xls"

Heb deze gewijzigd in:

ActiveWorkbook.SaveAs Filename:="G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Year(Now), "yyyy") & "\" & Format(Month(Now), "mmmm") & "\" & Format(Date, "d-mm-yyyy") & ".xls"

Ook hier krijg ik nog een foutmelding.

Groetjes Danny. :thumb:

 

[Niels28]

Sorry had niet gezien dat je al had gereageerd of ingelogd was,

Ik had intussen de macro aangepast en getest, bij mij excel 2007 werkt het.

Niels

 

[danny147]

Beste Niels28

Op een of andere manier doet hij het wel, maar de maand wordt 12 ipv december in de code.

Groetjes Danny. :thumb:

 

[danny147]

Beste Niels28

Heb het kunnen oplossen en de extra's van jou erbij is fantastisch.

Hij maakt nu automatisch een map aan voor het jaar, maand en voert het bestandje in met de datum van vandaag.

Bestaande code is:

Private Sub WorkBook_beforeClose(Cancel As Boolean)
Melding = MsgBox("Bent je zeker dat je dit wilt opslaan ?", vbYesNo + vbExclamation, "Afsluiten...")
If Melding = vbYes Then
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm"))
End With

ActiveWorkbook.SaveAs Filename:="G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm") & "\" & Format(Date, "d-mm-yyyy") & ".xls"
ActiveWorkbook.Close SaveChanges:=True
End If
ThisWorkbook.Close SaveChanges:=False
End Sub

Groetjes Danny. :thumb:

 

[danny147]

Beste Niels28

Toch nog één vraagje,

Hoe komt het dat hij 2x maal vraagt, "Bent je zeker dat je dit wilt opslaan ?"

Groetjes Danny. :thumb:

 

[zapatr]

Danny,
Vba kent geen Nederlandse namen voor dagen en maanden. Wil je die in vba gebruiken dan zul je die daar eerst moeten vastleggen. Daarna kun je ze dan (bv. met horiz.- of vert.zoeken) ophalen.

 

[Niels28]

een beetje met een omweg omdat je het bestand eigenlijk 2x sluit.

blad1 cel A1 moet je zelf even kiezen waar dit tijdelijk komt te staan

Private Sub WorkBook_beforeClose(Cancel As Boolean)
If Sheets("Blad1").Range("a1").Value <> "x" Then


Melding = MsgBox("Bent je zeker dat je dit wilt opslaan ?", vbYesNo + vbExclamation, "Afsluiten...")
If Melding = vbYes Then
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm"))
End With

ActiveWorkbook.SaveAs Filename:="G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm") & "\" & Format(Date, "d-mm-yyyy") & ".xls"
Cancel = True
End If


Sheets("Blad1").Range("a1").Value = "x"
End If
ThisWorkbook.Close SaveChanges:=False
End Sub

Niels

 

[danny147]

Beste Niels28

Bedankt voor de oplossing.

Groetjes Danny. :thumb:

 

[danny147]

Beste Niels,

Na jaren aandringen is ons bedrijf overgestapt naar Excel 2007.
Nu moeten ze niks betalen om over te schakelen.
Voor versie 2010 zou dit $800.000 zijn !

Nu bij de vraag:

Het bestandje wordt geopend met een sjabloon xltm

Bij opslaan als werkt bovenstaande code niet meer, ook al heb ik xls gewijzigd in xlsx.
Wil deze dan laten opslaan als xlsx zonder macro's.

Kan iemand deze code aanpassen en mocht het lukken opslaan dmv 1x ja te klikken.

groetjes Danny. :thumb:

 

[Niels28]

Niet getest,

Private Sub WorkBook_beforeClose(Cancel As Boolean)
If Sheets("Blad1").Range("a1").Value <> "x" Then

Melding = MsgBox("Bent je zeker dat je dit wilt opslaan ?", vbYesNo + vbExclamation, "Afsluiten...")
If Melding = vbYes Then
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm"))
End With

ActiveWorkbook.SaveAs Filename:="G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm") & "\" & Format(Date, "d-mm-yyyy") & ".xlsx", FileFormat:=51
Cancel = True
End If

Sheets("Blad1").Range("a1").Value = "x"
End If
ThisWorkbook.Close SaveChanges:=False
End Sub

Niels

 

[danny147]

Beste Niels28,

Het bestandje sluit niet na het uitvoeren van de code !
Ik gebruik volgende aangepaste code:

Private Sub WorkBook_beforeClose(Cancel As Boolean)

Melding = MsgBox("Bent je zeker dat je dit wilt opslaan ?", vbYesNo + vbExclamation, "Afsluiten...")
If Melding = vbYes Then
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\")
If Not .FolderExists("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm")) Then .CreateFolder ("G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm"))
End With

ActiveWorkbook.SaveAs Filename:="G:\Ploegbazen ELE\Jonas\Uren invullen\" & Format(Date, "yyyy") & "\" & Format(Date, "mmmm") & "\" & Format(Date, "d-mm-yyyy") & ".xlsx", FileFormat:=51
Cancel = True
End If

ThisWorkbook.Close SaveChanges:=False
End Sub

Groetjes Danny. :thumb:

 

[Niels28]

en als je de cancel = true weghaalt?
Deze was voor het voorkomen van 2x de melding maar die IF heb je weggelaten.
Niels

 

[danny147]

Beste Niels28,

Zal deze morgenvroeg testen op het werk.

Groetjes Danny. :thumb:

 

[danny147]

Beste Niels28,

Nu sluit hij het bestandje af, maar wel door nog 2x te bevestigen.

Dit is geen probleem want we waren het al gewoon

Groetjes Danny. :thumb: