mappen aanmaken uit cel

[vrouw]

Ik heb in cel A1 en cel A2 twee verschillende namen staan.(A1=Test en in A2 staat een week nummer)
Nu wil ik dmv een macro dat er een map met SUBmap op de C schijf word aangemaakt met de waarden uit die twee cellen.
In dit geval dus een map Test met daarin een submap met het week nummer uit cel A2. Doordat de waarden in A1 en A2 varieert moet het dus daar naar kijken.
Uiteindelijk moet het bestand dus in de sub map worden opgeslagen.

 

[Warme bakkertje]

Uit de zoekfunctie van dit forum
http://www.helpmij.nl/forum/showthr...eselecteerde-cellen?highlight=directory+maken

 

[vrouw]

Thanks voor de verwijzing maar ik kan daar niet in vinden hoe ik het bestand in die aangemaakte mappen moet opslaan.

ik heb o.a dit in de sub staan:
HoofdMap = Sheet2.Range("B3")
SubMap = Sheet2.Range("D3")

en wil opslaan dmv deze maar dat gaat dus niet

ThisWorkbook.SaveAs " & HoofdMap & "\" & SubMap & Sheet2.Range("D3") and Sheet2.Range("K3") .xls

 

[Hoornvan]

vrouw,

Klopt het rode deel wel?
Moet dat ook niet & zijn?

ThisWorkbook.SaveAs " & HoofdMap & "\" & SubMap & Sheet2.Range("D3")[COLOR="red"] and [/COLOR]Sheet2.Range("K3") .xls

 

[vrouw]

ga ik proberen

 

[Warme bakkertje]

ThisWorkbook.SaveAs "C:\" & HoofdMap & "\" & SubMap & "\" & [Sheet2!D3] & "\" & [Sheet2!K3] & ".xls"

 

[vrouw]

Helaas krijg daarbij de volgende foutmelding:

Fout 1004 tijdens uitvoering:
Methode SaveAs van object_Workbook is mislukt.

Misschien ten overvloede maar hier de hele code.

Sub Opslaan()

    HoofdMap = Sheet1.Range("K3")
     SubMap = Sheet1.Range("C2") & Sheet1.Range("D2")

    ' eerst nog controle of voor beide mappen een naam opgegeven is in sheet2

    If HoofdMap <> "" And SubMap <> "" Then

        'nu controle of de hoofdmap al bestaat op de E: schijf

        If Dir("e:\" & HoofdMap, vbDirectory) <> "" Then

            If Dir("e:\" & HoofdMap & "\" & SubMap, vbDirectory) = "" Then
                MkDir "e:\" & HoofdMap & "\" & SubMap
            End If
        Else

            ' de hoofdmap maken als die nog niet bestaat

           ' MsgBox "De hoofdmap wordt nu eerst gemaakt omdat die nog niet bestaat, daarna word ineens de submap gemaakt"
            MkDir "e:\" & HoofdMap

            ' opnieuw de subroutine om de submap te maken

            Opslaan

        End If

    Else

        ' deze melding krijg je als beide namen niet opgegeven zijn in sheet2

        'MsgBox "Er moet in Sheet1 in K3 een hoofdmap, en in D2 een submap opgegeven worden. Kijk dit na aub."

    End If

volledigPath = "e:\" & HoofdMap & "\" & SubMap & "\"
ThisWorkbook.SaveAs "e:\" & HoofdMap & "\" & SubMap & "\" & [Sheet1!D3] & "\" & [Sheet1!K3] & ".xls"
    
End Sub

 

[gGerretje]

@ Warme Bakkertje

Ik heb hem ook geprobeerd.
Met een soortgelijke code als die je net gaf
in b3, c3 en d3 staan hoofdmapnaam, submapnaam en bestandsnaam
Dus:

HoofdMap = Blad1.Range("B3")
    SubMap = [Blad1!C3]
    pad = "D:\" & HoofdMap & "\" & SubMap & "\" & [Blad1!D3] & ".xls"
    ThisWorkbook.SaveAs "D:\" & HoofdMap & "\" & SubMap & "\" & [Blad1!D3] & ".xls"

(de variabele pad gebruik ik alleen om de foutcontrole te vergemakkelijken)

Maar hiermee wordt bij mij geen map aangemaakt.
Foutmelding geeft aan dat de map en/of het bestand niet bestaan.

Groetjes,
Ger

 

[Warme bakkertje]

@ Vrouw
Doe er eens een voorbeeldbestandje bij met waarden in de benodigde cellen + de volledige correcte naam die dan gevormd zou moeten worden, want met al die onnodige variabelen wordt het me pijn doen aan de ogen.

 

[vrouw]

Nou ik moest ff een nieuw bestandje maken omdat er nogal veel vertrouwelijke info in zat.

Hierbij dan, ik hoop zo duidelijk genoeg

 

[gGerretje]

Hallo Vrouw,

Je was er bijna met je code in je reactie van 18.37 uur.

Met een kleine aanpassing werkt het.
Ik wist zelf ook niet hoe dit moest, maar met jouw code ben ik ook weer wat wijzer geworden.

Bedankt en succes,

Groetjes,
Ger

 

[vrouw]

Dat ziet er goed uit Ggerretje.:thumb:
Morgen ga ik eea even testen op het werk.

 

[Warme bakkertje]

Test

 

[vrouw]

@Warme bakkertje, Bedankt ziet er ook goed uit. Hoewel het wat ingewikkelder is dan het bestand van gGerretje

Ik haal eruit wat ik kan gebruiken, wel weer wat van geleerd tenminste, nog maals dank.

 

[Warme bakkertje]

Hoezo ingewikkelder ?
Jouw code is herleidt tot 4 regels

 

[vrouw]

En daardoor begrijp ik niet helemaal meer wat er gebeurd. (zooo Blond)
Ik ben zeker geen VBA kenner, echter een beetje "houtje,Toutje" lukt nog net.

 

[gGerretje]

@ Vrouw
Niet wanhopen, ik was er ook niet op gekomen.
Stukje bij beetje komt die kennis vanzelf.
Per slot van rekening was jouw oplossing nog helemaal niet zo slecht.

@ Warme Bakkertje,

Als ik het goed begrijp, maakt het dus voor die rMkDir niet uit of de directory wel of niet bestaat.
Als hij niet bestaat wordt hij aangemaakt, en als hij wel bestaat geeft dat geen foutmelding (alleen dan dat scherm met de melding dat dat bestand in die map al bestaat).

Maar geef toe: die rMkDir ziet er simpel uit, maar je hebt hem wel eerst zelf geprogrammeerd.
En daar zit nou juist het verschil tussen jou (als zeer ervaren VBA-programmeur) en iemand die 'wel eens iets in VBA programmeert'

Een probleempje nog:
Ik zag dat je wel nog een foumelding krijgt als je kiest voor Nee (niet vervangen) of Annuleren.
Kun je die ook nog voorkomen?

Bedankt weer voor je tips.

Groetjes,
Ger

 

[trucker10]

Een probleempje nog:
Ik zag dat je wel nog een foumelding krijgt als je kiest voor Nee (niet vervangen) of Annuleren.
Kun je die ook nog voorkomen?

Bedankt weer voor je tips.

Groetjes,
Ger

Op mijn manier

Sub Opslaan_cmd_Click()
If WorksheetFunction.CountA([B3:D3]) <> 3 Then
    MsgBox "De verplichte velden zijn niet allemaal ingevuld": Exit Sub
Else
    rMkDir "D:\" & "\" & [B3] & "\" & [C3]
End If
[COLOR="darkred"][COLOR="red"]On Error Resume Next[/COLOR][/COLOR]
ThisWorkbook.SaveAs "D:\" & [B3] & "\" & [C3] & "\" & [Blad1!D3] & ".xls"
End Sub