Map aanmaken + Bestandsnaam opslaan als waarde uit cel in excel

[Arjan1234]

Hallo,

Ik ben bezig om een excel document qua invullen en opslaan automatisch te laten verlopen.
Waar ik op dit moment tegen aanloop is dat huidig excel document opgeslagen moet worden op het netwerk in een bepaalde directory.
Voorwaarde daarbij is dat hij in de volgende directory moet komen te staan:
G:\klanten\formulieren\...

De naam van de nieuw te maken subdirectory moet een vaste tekst "factuur" + de Celwaarde "E7" worden en het excel document zelf moet vervolgens daarin opgeslagen worden ook met de naam "factuur" + celwaarde "E7".

Stel:
Celwaarde "E7" is "Helpmij", dan moet de directory worden:
G:klanten\formulieren\factuur Helpmij

en het bestand moet dan worden opgeslagen in deze nieuw gemaakt directory:
G:klanten\formulieren\factuur Helpmij\factuur Helpmij.xls

Ik heb al veel dingen geprobeerd maar het is nog steeds niet gelukt, wie kan mij opweg helpen met een juiste code?
Ik gebruik MO Excel Pro 2003
Alvast bedankt.

 

[Niels28]

Sub opslaan()
Dim stPath As String
With Sheets("blad1")
    stPath = "G:\klanten\formulieren\"
    stPath = stPath & "factuur " & .Range("e7").Value & "\"
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(stPath) Then .CreateFolder stPath
    End With
    ActiveWorkbook.SaveAs Filename:=stPath & "\" & "factuur " & .Range("e7").Value & ".xls"
End With
End Sub

Niels

 

[Arjan1234]

Hallo Niels,

Bedankt voor je snelle reactie, mooie korte code. Er zat nog wel een klein foutje in (1X "\" teveel): ActiveWorkbook.SaveAs Filename:=stPath & "\" & "factuur " & .Range("e7").Value & ".xls"

de werkende code is nu:

Sub opslaan()
Dim stPath As String
With Sheets("blad1")
    stPath = "W:\Klanten\formulieren\"
    stPath = stPath & "factuur " & .Range("e7").Value & "\"
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(stPath) Then .CreateFolder stPath
    End With
    ActiveWorkbook.SaveAs Filename:=stPath & "factuur " & .Range("e7").Value & ".xls"
End With
End Sub

Super bedankt, ik ben er heel blij mee !!!! :thumb: