VBA - Copier une cellule à partir d'une feuille dans l'e-mail Outlook

Je suis nouveau sur VBA et j'ai créé le code suivant qui envoie un e-mail. Ma question est comment puis-je copier des cellules de ma feuille Excel que j'utilise actuellement pour être collé dans le fichier Excel?VBA - Copier une cellule à partir d'une feuille dans l'e-mail Outlook

Merci,

Sub CIR_Save_Email() 

Dim objoutlook As Object 
Set objoutlook = CreateObject("outlook.application") 

Dim objemail As Object 
Set objemail = objoutlook.createitem(olmailitem) 
Const olFormatHTML As Long = 2 

emailbodymessage = "<HTML><BODY>Hi Team," & _ 
"<br><br>Attached is the Display's CIR for today<br><br>" & _ 
"<b>Brief overview of CIR</b><br><br>" & _ 
"<b>Purpose:</b> To get a snapshot of what your current inventory levels by SKU are every day." & _ 
"<ul style=""list-style-type:circle"">" & _ 
    "<li><b>Unrestricted QTY</b> The total inventory at that DC (i.e.Deliveries Created + Available Qty)</li>" & _ 
    "<li><b>Deliveries Created:</b> Orders that are being processing at that DC (i.e. they will NOT be included in Available Inventory)</li>" & _ 
    "<li><b>Available:</b> How many cases are available to use at that DC </li>" & _ 
    "<li><b>Avail DOS:</b> How many DOS the available cases equate to</li>" & _ 
"<li><b>IT QTY:</b> How man cases are in transit</li>" & _ 
"<li><b>Avail +IT DOS:</b> How many DOS the available cases equate to</li>" & _ 
"</ul> </body> </html>" 

emailbodymessage2 = "<html><body><ul style=""list-style-type:circle"">" & _ 
"<li><b>Future Available:</b> The total DOS of cases Avail + IT</li>" & _ 
"<li><b>QI QTY:</b> How many cases are on Qualitiy (ie Non-Conformance)</li>" & _ 
"<li><b>Blocked QTY:</b> How many cases are blocked from ordering due to damages, short dating, expired, etc." & _ 
"<li><b>CM- months:</b> The forecasts of the months past (CM-1=July)</li>" & _ 
"<li><b>% to Fcst:</b> How much of your projected forecast has shipped this month</li>" & _ 
"<li><b>Current SNAP Fcst:</b> This month's projected forecast</li>" & _ 
"<li><b>CM+ months:</b> The forecasts of the months moving forward (CM+1= September)</li>" & _ 
"</ul> </body></html>" 

With objemail 
    .To = emaillist 
     .cc = "" 
    .Subject = "Display's CIR " & Date 
    .BodyFormat = olFormatHTML '// 2 
.HTMLBody = emailbodymessage & emailbodymessage2 

.display 

End With 

End Sub

Source

2017-10-19 Roz_sxo

Demandez-vous comment insérer un contenu supplémentaire à l'intérieur du corps e-mail? BTW vos deux segments HTML ont chacun des balises d'ouverture/fermeture complètes (c.-à-d. Chacune est une "page" HTML complète) - vous avez seulement besoin d'un ensemble d'ouverture et un ensemble de balises 'html' et' body') –

Oui je suis essayer de savoir comment ajouter des cellules copiées à partir d'une feuille de calcul dans le corps du message. Merci pour la contribution sur les balises HTML! –

Vous devrez expliquer un peu plus exactement ce que vous devez inclure: une gamme complète? large comment? Ou juste des valeurs individuelles? Où dans le courrier doit-il aller? –

Vous pouvez utiliser la fonction suivante (utilise en interne plage d'exportation en HTML) pour convertir gamme excel en html. Le code HTML résultant devrait alors être inclus dans votre corps HTML généré.

La fonction exporte Range dans le fichier créé temporaire HTML et des bandes contenu seulement div (sans l'entourer des balises HTML).

Cependant, je ne suis pas sûr si le formatage et d'autres détails correspondent à vos besoins. Une autre solution consiste à construire manuellement du HTML à partir de cellules, mais c'est beaucoup plus de travail.

Utilisation: str = GetHtml("Sheet1","D4:E6")

Public Function GetHtml(ByVal sheetName As String, ByVal rangeName As String) As String 
Dim fso As FileSystemObject 
Dim fileName As String 
Dim txtStream As TextStream 
Dim html As String 
Dim line As String 
Dim readLines As Boolean 

Set fso = New FileSystemObject 

Dim rng As range 
fileName = fso.GetSpecialFolder(2) & "\" & Replace(fso.GetTempName, ".tmp", ".html") 
If fso.FileExists(fileName) Then 
    fso.DeleteFile fileName 
End If 

Set rng = Sheets(sheetName).range(rangeName) 

ActiveWorkbook.PublishObjects.Add(SourceType:=xlSourceRange, fileName:=fileName, Sheet:=rng.Worksheet.Name, Source:=rng.Address, HtmlType:=xlHtmlStatic).Publish 
Set txtStream = fso.OpenTextFile(fileName, ForReading, False) 

readLines = False 
html = "" 
Do While Not txtStream.AtEndOfStream 
    line = txtStream.ReadLine 
    If InStr(line, "<!--START OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD") > 0 Then 
     readLines = True 
    End If 
    If readLines Then 
     html = html & vbCrLf & line 
    End If 
    If readLines And InStr(line, "<!--END OF OUTPUT FROM EXCEL PUBLISH AS WEB PAGE WIZARD") > 0 Then 
     readLines = False 
    End If 
Loop 
txtStream.Close 
Set txtStream = Nothing 

If fso.FileExists(fileName) Then 
    fso.DeleteFile fileName 
End If 
Set fso = Nothing 

GetHtml = html 

End Function

Source

2017-10-20 08:31:45 smartobelix

Vous avez dit que vous voulez 'copier certaines cellules de ma feuille Excel que je suis en train d'utiliser à coller dans le fichier Excel. Je pense que vous copiez d'Excel et collez dans le corps d'un Email, à droite.

Sub Mail_Selection_Range_Outlook_Body() 
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm 
'Don't forget to copy the function RangetoHTML in the module. 
'Working in Excel 2000-2016 
    Dim rng As Range 
    Dim OutApp As Object 
    Dim OutMail As Object 

    Set rng = Nothing 
    On Error Resume Next 
    'Only the visible cells in the selection 
    Set rng = Selection.SpecialCells(xlCellTypeVisible) 
    'You can also use a fixed range if you want 
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible) 
    On Error GoTo 0 

    If rng Is Nothing Then 
     MsgBox "The selection is not a range or the sheet is protected" & _ 
       vbNewLine & "please correct and try again.", vbOKOnly 
     Exit Sub 
    End If 

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

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

    On Error Resume Next 
    With OutMail 
     .To = "[email protected]debruin.nl" 
     .CC = "" 
     .BCC = "" 
     .Subject = "This is the Subject line" 
     .HTMLBody = RangetoHTML(rng) 
     .Send 'or use .Display 
    End With 
    On Error GoTo 0 

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

    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub 


Function RangetoHTML(rng As Range) 
' Changed by Ron de Bruin 28-Oct-2006 
' Working in Office 2000-2016 
    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" 

    'Copy the range and create a new workbook to past the data in 
    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 

    'Publish the sheet to a htm file 
    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 

    'Read all data from the htm file into RangetoHTML 
    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=") 

    'Close TempWB 
    TempWB.Close savechanges:=False 

    'Delete the htm file we used in this function 
    Kill TempFile 

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

https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

Source

2017-10-24 03:46:51 ryguy72

VBA - Copier une cellule à partir d'une feuille dans l'e-mail Outlook

Répondre

Questions connexes