VBA email onderwerk aanpassen

[roywaarts]

Hallo,

Ik ben onwijs goed geholpen met een code die een sheet verstuurd:

Sub Mail_ActiveSheet()
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String
    Dim strbody As String
    Dim cell As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
    Sheets("Lijst").Copy
    Set Destwb = ActiveWorkbook
    With Destwb
    FileExtStr = ".txt": FileFormatNum = -4158
    End With

   
    
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Export"

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            For Each cell In ThisWorkbook.Sheets("StartPagina").Range("C53:C60")
                If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "ja" Then
                    If strto = "" Then strto = stro & ";"
                    strto = strto & cell.Value & ";"
                End If
            Next cell
            
            .To = strto
            .CC = ""
            .BCC = ""
            .Subject = "Export Medewerkers Uren"
            For Each cell In ThisWorkbook.Sheets("Kies").Range("D1:D60")
        strbody = strbody & cell.Value & vbNewLine
    Next
             .body = strbody
            .Attachments.Add Destwb.FullName
            .Display
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Maar ik zou graag willen dat de bestandsnaam aangepast wordt naar de inhoud van een cel.
Bijvoorbeeld Tab1 CelA1

Hoe kan ik dit doen?

 

[ExcelAmateur]

Test dit eens,

Verander deze regel,

TempFileName = "Export"

in,

TempFileName = Blad1.Range("A1")

 

[roywaarts]

Helaas,
Dat doet ie niet

 

[ExcelAmateur]

Wat is de naam van tab1
Misschien moet het dit zijn,

TempFileName = sheets("Blad1").Range("A1")

Zet anders het bestandje even hier.

 

[ExcelAmateur]

Zou je zo vriendelijk willen zijn om als een vraag naar tevredenheid is op gelost,
deze dan ook als opgelost te zetten, dank u.

Je heb bij geen van je vragen dit gedaan.

 

[roywaarts]

Ja, natuurlijk
Ga ik doen

 

[ExcelAmateur]

Werkt de oplossing nu?

 

[roywaarts]

ik ga hem vandaag testen
Dat kan ik namelijk alleen op me werk doen haha

 

[roywaarts]

Helaas, met deze lukt het me ook niet.
Ik krijg het bestand ook niet geupload, misschien te groot?

Ik heb hem in me dropbox gezet:
https://www.dropbox.com/s/lkfw9mxv7z5f2qg/Voorbeeld Rooster 2016_3.xlsm?dl=0

 

[ExcelAmateur]

Ik heb het in de code van je vorige vraag aangepast.
Ik kan het niet downloaden van de Dropbox.

Je moet de naam van het blad in je eigen bestand natuurlijk aanpassen.
En in cel A1 moet natuurlijk wel wat staan.