Met behulp van onderstaande code wordt een bestand opgeslagen als pdf in een standaard directory (C:\mijn documenten). Er wordt automatisch een map aangemaakt met klachtnummer als naam van de submap. Dit werkt allemaal uitstekend, maar ik wil de standaard map voor opslag aangepast hebben. Hierbij moet de naamgeving van de submap intact blijven (en het controleren of de map al bestaat). Het lukt mij niet om dit in onderstaande VBA code voorelkaar te krijgen; mijn kennis schiet daarin te kort. Wie kan mij helpen?
Code:
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect Password:="?????"
Application.ScreenUpdating = False
With Sheets("Klachtformulier")
If ListOfComplaints.ListIndex = -1 Or T_klachtn°.Value = "Klachtnummer" Then
MsgBox "Kies eerst een klacht in de lijst!", vbCritical, "Klacht?"
ListOfComplaints.SetFocus
Exit Sub
End If
Dim sPad As String
Dim Pad() As String
Dim i As Integer
'Check of path bestaat anders mappen aanmaken
Pad = Split(Sheets("Klachtformulier").Range("B2").Value & (""), "")
For i = 0 To UBound(Pad)
sPad = sPad & Pad(i) & ""
If Dir(sPad, vbDirectory) = "" Then
MkDir sPad
End If
Next i
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPad & "\ " & "Klacht n° " & .Range("B2") & " " & " (" & Format(Now(), "dd-mm-yyyy h mm") & ")" & ".Pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
MsgBox "Het formulier is succesvol opgeslagen!"
ActiveSheet.Protect Password:="KolthofBV"
Application.ScreenUpdating = True
End Sub
Laatst bewerkt: