een macro button die het bestand automatisch in een map opslaat

[jeppojr]

Goedemiddag,

Ik ben al een paar dagen in mijn vrije uurtjes aan het stoeien om een knopje(dit zag ik ooit bij een vriend) in excel te maken die het bestand bij aanvinken ervan opslaat in een map onder een naam uit een cel(B6).
Om als het ware een backup/database te maken.
Ik krijg dit alleen niet voor elkaar.

zou iemand mij hier misschien mee kunnen helpen?

Bij voorbaat dank,

Met viendlijke groeten,

Jeppojr

 

[luibak]

Jeppojr,

Sub Macroopslaan()
'
' Voor opslaan van bestand

stPath = Sheets("Werkblad waar de locatie staat").Range("A1").Value & "\"
stfilename = Sheets("Werkblad waar de naam staat").Range("A6").Value
'voor geval dat map niet bestaat wordt deze aangemaakt.
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(stPath & "\") Then .CreateFolder stPath & "\"
End With
ActiveWorkbook.SaveAs stPath & stfilename & ".xlsm", FileFormat:=52

End Sub

Credits @ andere forum gebruikers,

Let er wel op dat bij deze code de naam van het bestand in cel A6 neit hetzelfde mag zijn als de naam van eht huidige bestand msichien dat iemand anders hier wat beters op weet.
(dit wat ik uit mijn totale code heb gedistileerd)
Je kan er ook voor kiezen om de naam van het bestand aan de datum van vandaag te koppelen zodat je het bestand steeds onder huidige datum opslaat


luibak

 

[jeppojr]

bedankt voor je snelle reactie! ik zal het vanavond uittesten.

groeten,
jesper

 

[jeppojr]

Luibak,

Hij maakt nu steeds een map aan waar die 1 bestand in op kan slaan.
Ik wil juist steeds een excel bestand in de zelfde map kunnen opslaan om alles bij elkaar te houden als backup/database.

is dit misschien ook mogelijk?

groeten,
Jeppojr

 

[luibak]

Sub Macroopslaan()
'
' Voor opslaan van bestand

stPath = Sheets("Werkblad waar de locatie staat").Range("A1").Value & "\"
stfilename = Sheets("Werkblad waar de naam staat").Range("A6").Value
'voor geval dat map niet bestaat wordt deze aangemaakt.
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(stPath & "\") Then .CreateFolder stPath & "\"End With
ActiveWorkbook.SaveAs stPath & stfilename & ".xlsm", FileFormat:=52

End Sub

Als je het rode verwijderd maakt hij de map niet meer aan maar je moet wel naggaan of de map waar je hem naar toe zit hebben wel bestaat en je deze goed heb staan.

Bijvoorbeeld. O:\Test\map waar het bestand in moet?
Waar nu het vraag teken staat moet het einde in de map zijn.(dus geen ? er achter

Als je een voorbeeld bestandje upload zal ik voor je kunnen kijken waar het mogelijk mis gaat(vergeet niet gevoelige informatie te verijderen)

 

[Warme bakkertje]

Sub Macroopslaan()
 stPath = Sheets("Blad1").Range("A1").Value & "\"
 stfilename = Sheets("Blad1").Range("A6").Value
 With CreateObject("Scripting.FileSystemObject")
      If Not .FolderExists(stPath) Then .CreateFolder stPath
 End With
 ActiveWorkbook.SaveAs stPath & stfilename & ".xlsm", FileFormat:=52
End Sub

Zo doet ie het wel.
Je kan eventueel bij stPath ook de padnaam zetten, zodat deze niet op je werkblad hoeft te staan.

 

[jeppojr]

Bekijk bijlage Verslag sjabloon.xlsmBekijk bijlage Verslag sjabloon.xlsm

Ik heb een voorbeeld bestandje toegevoegd
Het doel is om door middel van een vakje aan te te vinken, het bestand automatisch in 1 van de mappen op te slaan die ervoor staan (product ontwikkeling, verpakkings ontwikkeling enz..). Onder de project naam. Begrijp je mijn bedoeling?


Bedankt alvast!

groeten,
Jeppojr

 

[jeppojr]

Sub Macroopslaan()
 stPath = Sheets("Blad1").Range("A1").Value & "\"
 stfilename = Sheets("Blad1").Range("A6").Value
 With CreateObject("Scripting.FileSystemObject")
      If Not .FolderExists(stPath) Then .CreateFolder stPath
 End With
 ActiveWorkbook.SaveAs stPath & stfilename & ".xlsm", FileFormat:=52
End Sub

Zo doet ie het wel.
Je kan eventueel bij stPath ook de padnaam zetten, zodat deze niet op je werkblad hoeft te staan.

Hij geeft fout 9 het subscript valt buiten bereik. wanneer ik hem probeer te gebruiken. hoe kan dit? Dit is weg nu.
Alleen zou je me misschien kunnen vertellen waar ik precies de bestandslocatie moet plaatsen dan?
Als ik dat weet werkt hij volgens mij helemaal perfect!

Groeten,
Jeppojr

 

[Warme bakkertje]

Sub Macroopslaan()
For i = 5 To 7
    If Sheets("Blad1").CheckBoxes("Selectievakje " & i).Value = 1 Then
        stPath = "D:\" & Trim(Sheets("Blad1").Range("A" & i - 4).Value) & "\"
    End If
Next
stfilename = Sheets("Blad1").Range("B6").Value
With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(stPath) Then .CreateFolder stPath
End With
ActiveWorkbook.SaveAs stPath & stfilename & ".xlsm", FileFormat:=52
End Sub

Je moet nog wel "D\" wijzigen naar de juiste schijfbenaming.