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

Probleem met het maken van DIR.

Status
Niet open voor verdere reacties.
Ik heb jouw code gekopieerd en bij mij worden die mappen prima aangemaakt.
Wat er met ActiveWorkbook.SaveAs precies aan de hand is kan ik zo niet zeggen.
 
Voor alle zekerheid heb ik de strings een vaste invoer gegeven.

Code:
sHmap = "greppel" 'Sheets("lijst").Range("B4")
sSmap = "HZ001" 'Sheets("lijst").Range("C7")
slijst = Sheets("lijst").Range("Z1")

Maar dat haalt ook niets uit.
 
Behalve slijst ;)
 
Bij toeval zag ik dat de mappen direct op de T schijf staan ipv T:\ontwerpen.
 
Vreemd, bij mij maakt hij keurig het pad aan.
 
Behalve slijst

Klopt maar ik wilde eerst de dirs. aanmaken.

Ik denk dat het SaveAs opgelost is als het aanmaken van de mappen goed gaat.
 
Dit is mijn code

Code:
Dim sHmap As String
Dim sSmap As String
Dim slijst As String
Dim mPath() As String
Dim Teller As Integer

sHmap = "greppel" 'Sheets("lijst").Range("B4")
sSmap = "HZ001" 'Sheets("lijst").Range("C7")
slijst = Sheets("lijst").Range("Z1")

 mPath = Split("Ontwerpen\" & sHmap & "\" & sSmap, "\")

    ChDrive "T"
    ChDir "\"
    For Teller = 0 To UBound(mPath)
        If Dir(mPath(Teller), vbDirectory) = "" Then
            MkDir mPath(Teller)
            ChDir mPath(Teller)
        End If
    Next


'If Dir("T:\Ontwerpen\" & sHmap & "\" & sSmap, vbDirectory) = "" Then
 '   MkDir "T:\Ontwerpen\" & sHmap & "\" & sSmap
'End If
'If Dir("T:\Ontwerpen\" & sHmap & "\" & sSmap, vbDirectory) = "" Then MkDir "T:\Ontwerpen\" & sHmap & "\" & sSmap
FullFileName = "T:\Ontwerpen\" & sHmap & "\" & sSmap & "\" & slijst
While Len(Dir(FullFileName & "-" & i & ".xlsx")) > 0
i = i + 1
Wend
'ChDir "T:\Ontwerpen\" & sHmap & "\" & sSmap

Sheets("lijst").Copy
 ActiveWorkbook.SaveAs Filename:=FullFileName & "-" & i & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  ActiveWindow.Close
 
Ik heb in het direct venster gekeken bij
?mPath
Geeft niets aan en krijg compileer fout
 
mPath is een array en die vraag je als volgt uit:
?mPath(0)

En zo kun je in plaats van 0 ook 1 en 2 gebruiken.
2 is in dit geval het hoogste element in de array.
 
Ook dan krijg ik een compileer fout

"Sub of Functie niet gedefinieerd"
 
Ook dat kan alleen als de functie loopt en de array gevuld is.
Ik heb overigens vanavond verder geen tijd meer dus zul je alleen verder moeten stoeien.
 
Geen probleem

Ik dankje voor al je hulp

En een fijne avond nog
 
Heb het probleem opgelost.:d

Edmoor zei:
Kennelijk mag je vanuit VBA niet het hele pad in 1x aanmaken. Daar gaat het fout.
Ik heb het opgelost door de mappen 1 voor 1 aan te maken.
:thumb::thumb:

Denk niet dat het de juist manier van programmeren is maar het werk wel.:o
Het ziet er nu als volgt uit.
Code:
Private Sub CommandButton14_Click()
Dim sHmap As String
Dim sSmap As String
Dim slijst As String

sHmap = Sheets("lijst").Range("B4")
sSmap = Sheets("lijst").Range("C7")
slijst = Sheets("lijst").Range("Z1")
 
   
[COLOR="blue"]If Dir("T:\Ontwerpen\" & sHmap, vbDirectory) = Empty Then MkDir "T:\Ontwerpen\" & sHmap
ChDir "T:\Ontwerpen\" & sHmap
If Dir(sSmap, vbDirectory) = Empty Then MkDir sSmap
ChDir sSmap[/COLOR]
         
FullFileName = "T:\Ontwerpen\" & sHmap & "\" & sSmap & "\" & slijst
While Len(Dir(FullFileName & "-" & i & ".xlsx")) > 0
i = i + 1
Wend
ChDir "T:\Ontwerpen\" & sHmap & "\" & sSmap

Sheets("lijst").Copy
 ActiveWorkbook.SaveAs Filename:=FullFileName & "-" & i & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  ActiveWindow.Close

Ga mij nu bezig houden met een volgend probleem.:confused:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan