Standaard directory voor opslaan bestand aanpassen

Status
Niet open voor verdere reacties.
W

wroefkes

Gebruiker
Lid geworden
17 jan 2018
Berichten
27
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:
Begin door sPad in te stellen op de gewenste locatie:
Code: 
sPad = "D:\GewenstPad\"

Die kan je daarna laten aanvullen door de rest van je code die het pad verder bepaalt.
 
Laatst bewerkt door een moderator:
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
 
Beste Edmoor,

als ik onderstaande code ervan maak, dan heb ik in ieder geval de klacht in de juiste doelmap gekregen. Alleen wil ik dat er een submap gemaakt wordt in de doelmap met het nummer van de klacht (net zoals de oorspronkelijke code deed). Als een aangepaste klacht wordt opgeslagen moet deze in dat submapje geplaatst worden (deed de oorspronkelijke code ook).

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
    sPad = "D\Kantoorpersoneel\Voorbeeldmap\"
    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:="?????"
Application.ScreenUpdating = True
End Sub
 
Ik mis hier een dubbele punt:
Code: 
 sPad = "D[COLOR="#FF0000"]:[/COLOR]\Kantoorpersoneel\Voorbeeldmap\"
 
Dat klopt... per ongeluk fout overgenomen hier. In de code in mijn excelbestand staat het goed. Mijn opmerking/vraag wijzigt er niet door.
 
Voor de goede orde: in de code heb ik onderstaande coderegel uitgezet:

Code: 
'        sPad = sPad & Pad(i) & "\"'
 
Als de code verder ook niet veranderd is zou dat nog steeds moeten werken als het eerder al werkte.
De toevoeging van het standaardpad verandert daar niets aan.
 
Laatst bewerkt door een moderator:
@snb Ik weet nu niet waar je op doelt. Een voorbeeldbestand? Heb ik nu niet voorhanden helaas.

@Edmoor
Als ik sPad = sPad & etc weer 'aanzet' wordt in de doelmap een submap aangemaakt met als naam de doelmaplocatie en klachtnummer. Daarin wordt het pdf bestand geplaatst.
 
@Wroefkes

In #2 gaat het over code tags.
 
wroefkes zei:
@Edmoor
Als ik sPad = sPad & etc weer 'aanzet' wordt in de doelmap een submap aangemaakt met als naam de doelmaplocatie en klachtnummer. Daarin wordt het pdf bestand geplaatst.
Klik om te vergroten...

Dus?
 
Er moet een submap worden aangemaakt met als naam '2019 - 1' (als het klachtnr 1 betreft). Daarin het pdf bestand met naam 'klachtnr 1 + datum + tijdstip. Dat gebeurde met de oude code. Alleen standaard op de lokale schijf onder de documentenmap.
Ik wil dus alleen de opslaglocatie wijzigen en verder niets.
 
Bedankt Edmoor ik dat ik daarmee wel uit de voeten kan! Ik za het gaan testen. Goed weekend.
 
Beste Edmoor,

De optie om de opslaglocatie aan te passen werkt. Dan hoef ik de code verder niet aan te passen en krijgt de submap de naam van de klacht (2019 - 1, 2019 - 2, etc). Als ik sPad = T:\voorbeeld\voorbeeld benoem dan werkt voorgaande niet meer, maar wordt er een submap aangemaakt met de naam van sPad en dat is niet de bedoeling. Bovendien komt de klacht niet onder die betreffende submap te staan.

Het is in ieder geval opgelost!

Groet W.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan