waarde cel toevoegen aan bestandsnaam

[moensk]

ik heb een script voor het automatisch mailen van een pagina binnen excel.
hij maakt hier een nieuw bestand van als bijlage binnen de excel
2 vraagjes

hoe kan ik waarde van cel B2 in de bestandnaam krijgen en ook in "subject"
hieronder gedeelte van script wat ik graag zou aangepast hebben

TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

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

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = ""
            .cc = ""
            .BCC = ""
            .Subject = "Test"
            .Body = ""
            .Attachments.Add Destwb.FullName
            .Send
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With

 

[edmoor]

Zo bijvoorbeeld:

TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name[COLOR="#FF0000"] & Range("B2").Value &[/COLOR] " " & Format(Now, "dd-mmm-yy h-mm-ss")

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

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = ""
            .cc = ""
            .BCC = ""
            .Subject = "Test " & [COLOR="#FF0000"]Range("B2").Value[/COLOR]
            .Body = ""
            .Attachments.Add Destwb.FullName
            .Send
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With

 

[OctaFish]

Ik zie maar één vraag . Waar moet die celwaarde komen te staan?

TempFileName = "Part of " & Sourcewb.Name & " " Range("B2").Value & "_" & Format(Now, "dd-mmm-yy h-mm-ss")

Bijvoorbeeld.

 

[edmoor]

Hoi OctaFish,

Je voorbeeld mist een & teken.

 

[moensk]

Edmoor
aangepast en werkt super, thanks

 

[OctaFish]

Typefoutje is snel gemaakt . Idee is uiteraard hetzelfde.

 

[snb]

Vermijd overbodige variabelen (zeker als het Object-variabelen zijn) !

  c00 = Environ("temp") & "\Part_of_" & Thisworkbook.name & Format(Now, "_ddmmmyy_hmmss")
  Thisworkbook.SavecopyAs c00

  With CreateObject("Outlook.Application").CreateItem(0)
    .To = ""
    .cc = ""
    .Subject = cells(4,2)
    .Attachments.Add c00
    .Send
  End With

  Thisworkbook.Close 0

 

[moensk]

Bijkomende vraag :
hoe kan ik in de "Body" de tekst zetten van bereik (A37:E52)

heb geprobeerd met Range("A37:E52").Value maar dat werkt niet

 

[OctaFish]

Kijk eens bij Ron de Bruin voor voorbeeldjes.

 

[moensk]

oke - thanks ga daar kijken

 

[OctaFish]

Je geeft overigens niet precies aan wat je wilt; als je de cellen uitgelezen wilt hebben, en de waardes ervan in de bodytekst wilt, dan gaat dat niet via de aangegeven methodes. Dan zul je de cellen uit moeten lezen en in een string zetten.

 

[edmoor]

Of zo:

TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & Range("B2").Value & " " & Format(Now, "dd-mmm-yy h-mm-ss")

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

With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    With OutMail
        .To = ""
        .cc = ""
        .BCC = ""
        .Subject = "Test " & Range("B2").Value
        .HTMLBody = RangetoHTML(Range("A37:E52"))
        .Attachments.Add Destwb.FullName
        .display [COLOR="#008000"]'Send[/COLOR]
    End With
    On Error GoTo 0
    .Close savechanges:=False
End With

Met dit in een Module:

Function RangetoHTML(rng As Range)
[COLOR="#008000"]' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016[/COLOR]
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    [COLOR="#008000"]'Copy the range and create a new workbook to past the data in[/COLOR]
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    [COLOR="#008000"]'Publish the sheet to a htm file[/COLOR]
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    [COLOR="#008000"]'Read all data from the htm file into RangetoHTML[/COLOR]
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    [COLOR="#008000"]'Close TempWB[/COLOR]
    TempWB.Close savechanges:=False

    [COLOR="#008000"]'Delete the htm file we used in this function[/COLOR]
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

 

[moensk]

Edmoor
thanks, data code had ik intussen gevonden op site van Ron
alleen de module code maakt hem werkend
super bedankt

 

[snb]

Herhaling: vermijd overbodige Object-variabelen.

Een alternatieve website: https://www.snb-vba.eu/VBA_Excelgegevens_mailen.html#L_2.3.3

 

[moensk]

Edmoor,
mag ik nog één scriptje vragen

hoe kan ik een tabel in de body plakken ?

 

[edmoor]

Plaats een voorbeeld van een document met zo'n tabel.

 

[moensk]

Edmoor,
in bijlage een voorbeeld
het is tabel "Body" (zo heb ik hem even genoemd) dat gekopieerd zou moeten worden in de mail.
er wordt gewerkt in tabblad "controle" waarbij wagennr aangepast wordt en nadien drukt men op knop "Pallets" en knop "boordcomputer"

ik heb nu data laten staan van wagen 3205 en 3206

 

[edmoor]

Doe dat eens zo:

.HTMLBody = RangetoHTML(Range(ActiveSheet.ListObjects("Body").DataBodyRange.Address))

 

[snb]

@moensk

Heb jij een bril die bepaalde bijdragen filtert ?

 

[moensk]

ongelooflijk bedankt aan iedereen voor de snelle en goede scripts of opmerkingen !