• 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.

bestand in submap opslaan op basis van datum gegevens uit cel

Status
Niet open voor verdere reacties.
D

davylenders123

Gebruiker
Lid geworden
20 jun 2010
Berichten
902
Heb een macro gemaakt die een bestand van een netwerk dat ik open heb het volgende doet.
De afdruk bereiken en ligging blad gaan aanpassen (dit om het nadien op 1 blad te laten afdrukken.
En gaat het bestand ergens opslaan op pc.
Slaat het op met de datum die in het tabblad dagraporten staat in cel M3.
In de map "Gegevens Scanners" waar het bestand wordt opgeslagen zijn voor elke maand een apart sub map.

1 jan 2015
2 Feb 2015
3 Maart 2015
enz..

Kan ik er voor zorgen dat de bestanden niet in de map "Gegevens Scanners" terecht komen maar onmiddellijk in de juist sub map van de juiste maand ?
Op basis van de datum uit cel M3


Code: 
Sub gegevens_scanners_opslaan()
'
'
Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True

    ActiveWorkbook.SaveAs Filename:=("G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners" & "\Gegevens van skorpio scanners van  " & [DagRapport!M3] & ".xls")

        
End Sub
 
Laatst bewerkt:
Ik weet niet hoe je de datum precies hebt, maar is het een idee om case te gebruiken voor elk geval?

Maand = range("m3").value
Code: 
Select Case Maand
Case Januari
      Mapnaam = "Januari"
etc

Case Else
msgbox("Er gaat iets fout")

Code: 
ActiveWorkbook.SaveAs Filename:=("G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners" & "\Gegevens van skorpio scanners van\  " &Mapnaam\ [DagRapport!M3] & ".xls")

Ik kan het nu niet testen en ben ook geen expert maar dit zou het moeten doen.
 
Maak eerst een uniforme mappenstructuur aan. Maart = mmmm en jan en feb is mmm. Dan wordt het lastig om de juiste map te vinden. En om de sortering in beetje makkelijk te houden zou ik kiezen voor jjjjmm als mapnaam.

Van M3 kan je dan in code het volgende maken
Code: 
Format(Range("M3"),"yyyymm")
 
Laatst bewerkt:
Eentouw

Ik geraak niet echt verder.

Waar moet ik u code case juist zetten.
En is dit zoals het zou moeten zijn

Code: 
Select Case Maand
Case Januari
      Mapnaam = "Januari"
Case Februari
      Mapnaam = "Februari"
Case Maart
      Mapnaam = "Maart"
Case April
      Mapnaam = "April"
Case Januari
      Mapnaam = "Mei"
Case Juni
      Mapnaam = "Juni"
Case Juli
      Mapnaam = "Juli"
Case Augustus
      Mapnaam = "Augustus"
Case September
      Mapnaam = "September"
Case Oktober
      Mapnaam = "Oktober"
Case November
      Mapnaam = "November"
Case December
      Mapnaam = "December"

Case Else
MsgBox ("Er gaat iets fout")


VenA

Ben met u oplossing ook al aan de slag gegaan maar geraak er ook niet mee verder.
Heb de mapnamen aangepast zoals je aangeeft.

2015 01
2015 02
2015 03
2015 04
2015 05
2015 06
2015 07
2015 08
2015 09
2015 10
2015 11
2015 12

En de code die opslaagd heb ik als volgt aangepast.

Code: 
ActiveWorkbook.SaveAs Filename:=("G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners" & "\Gegevens van skorpio scanners van  " & [DagRapport!Format(Range("M3"),"yyyy mm")] & ".xls")

Volledige code dan

Code: 
Sub gegevens_scanners_opslaan()
'
'
Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True

    ActiveWorkbook.SaveAs Filename:=("G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners" & "\Gegevens van skorpio scanners van  " & [DagRapport!Format(Range("M3"),"yyyy mm")] & ".xls")

        
End Sub

Maar blijf met de 2 verschillende zaken op foutmeldingen lopen :confused:
Wat doe ik fout :o
 
Als je code maakt en niet weet waar het vastloopt dan kan je het beter even opsplitsen.

De fouten: er staan haakjes om de bestandsnaam. Er staan spaties in de padnaam je mist een "\" (eigenlijk twee) in de padnaam en je geeft eigenlijk geen bestandsnaam op.

Probeer zoiets dan kan je met F8 snel zien waar het fout gaat.

Code: 
pad = "D:\Temp\" & Format(Sheets("Dagrapport").Range("M3"), "yyyy mm") & "\"
naam = Sheets("Dagrapport").Range("M3") & ".xls"
ActiveWorkbook.SaveAs Filename:=pad & naam

Natuurlijk wel even bij pad jouw locatie neerzetten.
 
Lukt niet echt , ik heb deze code nu ingevoegd .

Code: 
pad = "G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners" & Format(Sheets("Dagrapport").Range("M3"), "yyyy mm") & "\"
naam = Sheets("Dagrapport").Range("M3") & ".xls"
ActiveWorkbook.SaveAs Filename:=pad & naam

En loopt dan vast op Activeworkbook....
 
Code: 
pad = "G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners[COLOR="#FF0000"][B]\[/B][/COLOR]"
 
Laatst bewerkt:
Code: 
pad = "G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners\" & Format(Sheets("Dagrapport").Range("M3"), "yyyy mm") & "\"
naam = Sheets("Dagrapport").Range("M3") & ".xls"
ActiveWorkbook.SaveAs Filename:=pad & naam

Blijft op zelfde punt vast lopen:confused:
 
Ik kan van hieruit jouw mappen structuur niet bekijken maar volgens mij ga je daar ergens de fout in.

Onder deze "boom" staan zeer waarschijnlijk niet de submappen 2015 01 etc.
Code: 
pad = "G:\Pakketten\Mag-Data\gegevens sorteerband\Gegevens Scanners\

Plaats anders jouw bestandje eens.
 
Heb de fout gevonden.
Had de mappen nog 201501 staan in plaats van op 2015 01:o

Het werkt nu.:thumb:


Enkel nog een vraagje , is het mogelijk dat de naam niet enkel uit de datum bestaat maar dat je er bv " Gegevens van skorpio scanners van" bij kan laten komen .
Dat het "Gegevens van skorpio scanners van 6-2-2015" wordt en niet enkel "6-2-2015" ?
 
Ja.

naam = "Gegevens van skorpio scanners van " & Sheets("Dagrapport").Range("M3") & ".xls"
 
VenA

B E D A N K T :thumb::thumb:

Dit bespaard mij weer een hoop tijd.
Nu kan ik al de andere bestanden die het zelfde werken ook zo aanpassen .:d
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan