• 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.

Automatische mailen na het opslaan en nummering

  • Onderwerp starter Onderwerp starter Kaway
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

Kaway

Gebruiker
Lid geworden
6 okt 2010
Berichten
21
Beste lezers,

Welke code moet ik nog meer toevoegen om een werkblad te mailen. Nu heb ik het voor elkaar dat hij gaat nummeren en opslaan. maar ik wil graag alleen blad 1 mailen naar degene.

Sub tst()
Dim Nr As Integer, Pad As String, c1 As String, x As String, Naam As String, i As Integer
Dim Omschr As String
Omschr = Range("F11") & Format(Now, "MM") 'zoek naar factuurnrs van het huidige jaar
Pad = MijnPad & IIf(Right(MijnPad, 1) <> "\", "\", "")
c1 = Dir(Pad & Omschr & "*.xls*") 'zoek xls-files (en xlsm,xlsx, ...) die beginnen met bovenstaande omschrijving
Do Until c1 = "" 'zoeken tot je alle files langsgelopen hebt
x = Replace(c1, Omschr, "") 'verwijder omschrijving
i = InStr(1, x, ".xls") 'nu nog de file-extensie
If i > 0 Then x = Left(x, i - 1)
If IsNumeric(x) Then 'is wat overblijft nog numeric
Nr = WorksheetFunction.Max(Nr, CInt(x)) 'zoek hoogste nummer tot nogtoe
End If
c1 = Dir
Loop

Naam = Omschr & Format(Nr + 1, "00") 'naam van de factuur (voor het geval je max. 999 facturen per jaar maakt
[Blad1!A1].Value = Naam
ThisWorkbook.SaveAs Pad & Naam & ".xls"
Workbooks.Open (Pad & "Map1.xls")
ThisWorkbook.Close
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan