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

Opslaan in bepaalde map op basis van celwaarde met Macro

Status
Niet open voor verdere reacties.

rob83

Gebruiker
Lid geworden
18 jan 2016
Berichten
7
Ik wil met een macro een bestand opslaan in een bepaalde map op basis van een celwaarde.

Ik heb al onderstaande code, maar daarbij geef ik zelf in de macro aan waar het wordt opgeslagen, met als naam de inhoud van cel B4.
Het is de bedoeling dat het bestand met deze naam (cel B4) in een submap wordt opgeslagen met de naam die staat in cel B5. Als deze map nog niet bestaat, moet deze automatisch worden aangemaakt, maar kij kan dus al wel bestaan.

Code:
Sub SlaOp()

Dim strFileName As String

strFileName = Range("B4").Value

    ActiveWorkbook.SaveAs Filename:="N:\Projecten\Begroting\" & strFileName & ".xlsx", _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

End Sub

Deze code zit verwerkt aan het eind van een groter macro, en de laatste stap daarbij moet zijn dat hij opslaat in de submap.
Dat ik de vraag krijg of ik wil opslaan zonder macro's is niet erg; het doelbestand hoeft deze niet te bevatten. Ik kopieer hiermee namelijk een deel van de data uit een origineel document en dat moet apart opgeslagen worden om extern te versturen.

Alvast bedankt!

Rob
 
En wat staat er in B5 dan? Alleen de naam van de submap of het volledige pad? Met de Dir functie kan je testen of een map bestaat.
 
De naam van de submap. Rest van het pad blijft steeds hetzelfde en mag niet zichtbaar zijn in de data op het werkblad.
 
Probeer dit eens :

Code:
Sub Maakdir()
Dim mypath As String
Dim strFileName As String

strFileName = Range("B4").Value
mypath = Range("B5").Value

If Len(Dir("N:\Projecten", vbDirectory)) = 0 Then
        MkDir "N:\Projecten"
    End If
If Len(Dir("N:\Projecten\Begroting", vbDirectory)) = 0 Then
        MkDir "N:\Projecten\Begroting"
    End If
If Len(Dir("N:\Projecten\Begroting\" & mypath, vbDirectory)) = 0 Then
        MkDir "N:\Projecten\Begroting\" & mypath
    End If

ActiveWorkbook.SaveAs Filename:="N:\Projecten\Begroting\" & mypath & "\" & strFileName & ".xlsx", _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
 
Laatst bewerkt:
Code:
Sub VenA()
  c00 = "N:\Projecten\Begroting\"
  ar = Sheets("Sheet1").Range("B4:B5")
  If Len(Dir(c00 & ar(2, 1), 16)) = 0 Then MkDir c00 & ar(2, 1)
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs c00 & ar(2, 1) & IIf(Right(ar(2, 1), 1) = "\", "", "\") & ar(1, 1) & ".xlsx", 51
End Sub
 
Code:
If Dir(c00 & ar(2, 1), 16) = "" Then MkDir c00 & ar(2, 1)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan