Probleem met het maken van DIR.

[Atwist]

Hallo,

Ik gebruik onderstaande code om als de dir. nog niet bestaat dan maken.
Dit heeft gewerkt dacht ik maar had telekens met dezelfde map getest nu wil ik mijn tool gaan gebruiken en geef dus een andere dir. naam en het loopt vast.
Heb alles al nagegaan maar ik zie het niet.
Loopt vast op met rood aangegeven gedeelte

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

Via het direct venster zie ik de volgende gegevens:

?shmap
greppel
?ssmap
HZ001
?slijst
ES123

Maar wat er nu aan de hand is, ik weet het niet.
Krijg alleen de melding "fout 75 toegangsfout bij pad of bestand".

Heeft iemand even tijd om te kijken.

 

[edmoor]

Wijzig

If Dir("T:\Ontwerpen\" & sHmap & "\" & sSmap, vbDirectory) = "" Then MkDir "T:\Ontwerpen\" & sHmap & "\" & sSmap

in

If Dir("T:\Ontwerpen\" & sHmap & "\" & sSmap, vbDirectory) = "" Then
    MkDir "T:\Ontwerpen\" & sHmap & "\" & sSmap
End If

 

[Atwist]

Hallo Ed,

Het blijft vastlopen op MkDir "T:\Ontwerpen\" & sHmap & "\" & sSmap

 

[edmoor]

Wat is de vertaling van sHmap en sSmap?

 

[Atwist]

?shmap
greppel
?ssmap
HZ001
?slijst
ES123

 

[edmoor]

Dat had je al verteld. Sorry ;-)
Ik kijk ff verder.

 

[edmoor]

Doe het in het direct venster eens zo:
?"[" & sHmap & "]"

Als er namelijk achter greppel een spatie staat wordt HZ001 niet aangemaakt.

 

[Atwist]

Dan krijg ik het volgende:

?"[" & sHmap & "]"
[]


Ben er ook achter dat als ik de hoofdmap (sHmap) zelf aanmaak dan werk het wel.

 

[edmoor]

Het programma moet wel in debug mode draaien en de variabelen al gevuld zijn als je dat commando in het direct venster geeft.

 

[Atwist]

Sorry Ed


?"[" & sHmap & "]"
[greppel]


Rechts onder staat op de knop staat "Snel reageren" maar het kan ook te snel zijn

 

[edmoor]

Dat is in ieder geval goed.
En als je hetzelfde even doet voor sSmap ?

 

[Atwist]

Heb gelijk dit ook voor slijst ge dan.

?"[" & sSmap & "]"
[HZ001]

?"[" & slijst & "]"
[ES123]

 

[edmoor]

Ok, ook in orde.
Als test kun je nu in een dosbox dat hele commando ingeven om te kijken wat er gebeurd.

MkDir T:\Ontwerpen\greppel\HZ001

 

[Atwist]

Dat gaat goed de dirs worden netjes gemaakt

 

[edmoor]

Dan denk ik niet dat het programma op die mkdir regel fout gaat.

 

[edmoor]

Toch wel
Ik kijk even verder.

 

[Atwist]

Er moet toch iets zijn met het maken van "sHmap".
Wandt asl ik de "sHmap" handmatig aanmaak dan wordt de sub map "sSmap" en "slijst" gewoon gemaakt.

 

[edmoor]

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.

Sub test()
    Dim sHmap As String
    Dim sSmap As String

    Dim mPath() As String
    Dim Teller As Integer

    sHmap = "greppel"
    sSmap = "HZ001"

    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
End Sub

Dit kun je ook in je eigen programma toepassen.

 

[Atwist]

Ed

De mappen worden nog steeds niet gemaakt, nu is er weer een probleem met SaveAs

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

sHmap = Sheets("lijst").Range("B4")
sSmap = 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

 

[Atwist]

Eerlijk gezegt ik snap er geen bal meer van het gaat echt boven mijn kunnen.

Ik wil je heel graag allerlij info geven maar mijn kennis houd echt op.