Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
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.
sHmap = "greppel" 'Sheets("lijst").Range("B4")
sSmap = "HZ001" 'Sheets("lijst").Range("C7")
slijst = Sheets("lijst").Range("Z1")
Behalve slijst
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
:thumb::thumb: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.
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
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.