'Stuk voor opslaan
If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
c00 = Sheets("InvoerSheet").Range("P14").Value & "\" & Sheets("InvoerSheet").Range("I12").Value
FolderLocatie = DefaultFolder & Year(Now())
CreateObject("shell.application").Namespace(FolderLocatie).newfolder "\offertes" & c00 & "\"
ThisWorkbook.SaveAs FolderLocatie & "\" & c00 & "\" & c00 & ".xlsm", 52
'Stuk voor opslaan
'If Sheetnaam = "Offerte" Or Sheetnaam = "Voorlopig" Then
' FolderLocatie = DefaultFolder & Year(Now()) & "\offertes\" & Sheets("InvoerSheet").Range("P14")
' If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
' BestandsNaam = "Offerte " & Sheets("InvoerSheet").Range("P14").Value & "_" & Range("I12").Value
Else
FolderLocatie = DefaultFolder & Year(Now()) & "\facturen"
If Dir(FolderLocatie, vbDirectory) = "" Then MaakFolder FolderLocatie 'als folder niet bestaat maak dan folder aan
Sheets("InvoerSheet").Range("J26").Value = HoogsteNummer(FolderLocatie) + 1
BestandsNaam = Sheets("InvoerSheet").Range("J26").Value & "_" & Sheets("InvoerSheet").Range("P14").Value
End If
If Dir(FolderLocatie & "\" & BestandsNaam & ".xlsm") <> "" Then 'Als folder al bestaat, voeg er een nummer aan toe
i = 1
While Dir(FolderLocatie & "\" & BestandsNaam & "_" & i & ".xlsm") <> ""
i = i + 1
Wend
BestandsNaam = BestandsNaam & "_" & i
End If
Call SlaOp(Sheetnaam, BestandsNaam, FolderLocatie)
If Sheetnaam <> "Credit Factuur" And Sheetnaam <> "Voorlopig" Then
Call MailMetPDFBijlage(BestandsNaam, FolderLocatie, Sheetnaam)
End If
Application.ScreenUpdating = True
Dim wbk As Workbook
Application.DisplayAlerts = False
ThisWorkbook.Saved = True
For Each wbk In Workbooks
If wbk.Name <> ThisWorkbook.Name Then
ThisWorkbook.Close
Exit Sub
End If
Next
Application.Quit
End Sub
Function HoogsteNummer(FolderNaam As String) As Long
Dim MyObj As Object, MySource As Object, file As Variant
Set MyObj = CreateObject("Scripting.FileSystemObject")
Set MySource = MyObj.GetFolder(FolderNaam)
HoogsteNummer = Year(Now()) * 1000 + 10 'begin waarde
For Each file In MySource.Files 'loop door alle files in de folder
If IsNumeric(Left(file.Name, 7)) Then
If Left(file.Name, 7) > HoogsteNummer Then 'kijk of de waarde van de eerste 7 getallen groter is als het hoogste getal
HoogsteNummer = Left(file.Name, 7) 'maak hoogste getal gevonde waarde
End If
End If
Next file
End Function
Sub SlaOp(Sheetnaam As String, BestandsNaam As String, FolderLocatie As String)
On Error Resume Next
If Sheetnaam <> "Voorlopig" Then
Sheets(Sheetnaam).Visible = True 'de volgende methode werkt alleen als de sheet te zien is.
Sheets(Sheetnaam).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=FolderLocatie & "\" & BestandsNaam & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Sheets(Sheetnaam).Visible = False 'maak sheet weer onzichtbaar
End If
ActiveWorkbook.SaveCopyAs Filename:=FolderLocatie & "\" & BestandsNaam & ".xlsm" 'sla actief document op
End Sub