Function OpslaanAls(strBestandslocatie As String, strBestandsnaam As String)
' Fuctie kan als volgt gebruikt worden: OpslaanAls "C:\Bureaublad\", "BestandsnaamZonderNummer"
On Error Resume Next ' Zorgt er voor dat de functie niet blokkeert wanneer er bestanden in die map zitten, die problemen veroorzaken
Dim i As Integer ' Nummer dat aan je bestand gegeven gaat worden
Dim iTemp As Integer ' Hoogste nummer dat gevonden wordt in je map
Dim Bestand As String ' Gevonden bestandsnaam
Dim iBestandsnaam As Integer ' Aantal karakters in je bestandsnaam, om te kunnen bepalen op welke plaats je nummer staat
Err.Number = 0 ' Wanneer er geen fout is, staat de Err.Number automatisch op 0. Nu zet ik dit opzettelijk op 0 omdat ik wil controleren of er een fout voorkomt.
iBestandsnaam = Len(strBestandsnaam) ' Vaststellen van het aantal karakters in je bestandsnaam
i = 0 ' Dit kan weggelaten worden, tenzij je niet met nummer 1 wil beginnen, maar met een ander nummer. Gebruik géén negatieve nummers.
Bestand = Dir(strBestandslocatie & bestandsnaam & "*.pdf") ' Bestand wordt gezocht op de bestandslocatie, maar enkel degene die ook de bestandsnaam hebben
If Bestand <> "" Then
While Bestand <> "" ' Loopt door alle aanvaardbare bestanden
iTemp = CInt(Mid(Bestand, iBestandsnaam + 2, 4)) ' Bepaalt het nummer van het gevonden bestand. Hier zou een fout kunnen ontstaan, wanneer je bijvoorbeeld een letter wil omzetten naar een nummer.
If Err.Number = 0 Then ' De code loopt door zolang er geen fout vastgesteld is.
If iTemp > i Then ' te gebruiken bestandsnummer wordt gewijzigd wanneer er een hoger nummer gevonden wordt.
i = iTemp
Bestand = Dir()
End If
Else ' Wanneer er echter wel een fout vastgesteld wordt, dan moeten de noodzakelijke handelingen toch nog uitgevoerd worden
Bestand = Dir()
Err.Number = 0 ' waarna de Err.Number terug op 0 komt.
End If
Wend
End If
i = i + 1 ' i is nu gelijk met het hoogste gevonden nummer (of 0 wanneer er geen gevonden is). Vermits dit nummer al bestaat wordt er dus 1 bijgeteld.
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strBestandslocatie & strBestandsnaam & "-" & Format(i, "0000") & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False ' opslaan van het werkblad. Vermits dit bijna automatisch samenhangt met deze functie, zou ik dit er niet van loskoppelen.
End Function
.
