Makro i Excel / Outlook

Har oprettet filen basis.xls i en mappe - koden ligger i VBA/Ark1
I samme mappe er der oprettet en undermappemed navnet xlsArkiv - her gemmes de filer, som tilpasses på grundlag af "basis" og efterfølgende sendes via Outlook.
Filerne lagres i xlsArkiv under det valgte filnavn fra C6 - indledende med et løbenr, der beregnes på basis af antallet af filer i xlsArkiv. Derfor må disse filer ikke slettes - eller princippet skal laves om - hvilket også kan lade sig gøre - f.eks. via en tekstfil, der indeholder løbenr.

Kode ser således ud:

Dim xSti, filNr, filNavn
Const gemMappe = "xlsArkiv\"                        'mappe til filer, der sendes - ligger i samme mappe som basis.xls
Sub KlarTilOutLook()
    findSti
    filNr = findNæsteFilnr
    gemFilen
   
    sendFilen "Modtager@mail.dk", filNavn, ActiveWorkbook.FullName      'modtager@mail.dk skal erstattes af ........
   
Rem Luk filen
    ActiveWorkbook.Close
End Sub
Private Sub findSti()
    xSti = ActiveWorkbook.Path
    If Right(xSti, 1) <> "\" Then
        xSti = xSti + "\"
    End If
End Sub
Private Function findNæsteFilnr()                  'tæller antal filer i mappen
    Dim fs, f, f1, fc, s, antalFiler
    antalFiler = 0
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(xSti + gemMappe)
    Set fc = f.Files
    For Each f1 In fc
        antalFiler = antalFiler + 1
    Next
   
    findNæsteFilnr = antalFiler + 1
End Function
Private Sub gemFilen()
Dim xFilnr
    xFilnr = fireTegn(CStr(filNr))                          'udvid filnr til 4 tegn
   
    filNavn = Range("C6").Value
   
    ActiveWorkbook.SaveAs Filename:=xSti + gemMappe + "Fil_" + xFilnr + "_" & filNavn + ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Private Function fireTegn(nr)
    While Len(nr) < 4
        nr = "0" + nr
    Wend
   
    fireTegn = nr
End Function
Public Sub sendFilen(modtager, emne, vedhft)
Dim mailApp, Namespace, nyMail, att
        Set mailApp = CreateObject("Outlook.Application")
        Set Namespace = mailApp.GetNamespace("MAPI")
   
        Set nyMail = mailApp.CreateItem(olMailItem)
        Set nymod = nyMail.Recipients
        nymod.Add modtager
       
        Set att = nyMail.Attachments
        att.Add vedhft
        nyMail.Subject = emne
   
        nyMail.Display                            'visning af mail
        nyMail.Send                                'send mailen
End Sub

Mange tak - hvordan accepterer jeg så du får point ?

Selv tak - du får et svar og så accepterer du blot dette.