1

Excel シートから Outlook メールに画像を追加しようとしています。

ネットワーク上の場所とインターネットに保存されている画像へのリンクを使用してみました。ただし、すべてのユーザーがこれらの場所にアクセスできるわけではありません。

画像を別のワークシートに保存してから、メール本文にコピーすることはできますか?

形状をエクスポートできないため、以下が機能しないことはわかっていますが、このようなことはできますか?

ActiveUser = Environ$("UserName")
TempFilePath = "C:\Users\" & ActiveUser & "\Desktop\"

Sheets("Images").Shapes("PanelComparison").Export TempFilePath & "\PanelComparison.png"
panelimage = "<img src = ""TempFilePath\PanelComparison.png"" width=1000 height=720 border=0>"
4

2 に答える 2

1

CreateEmail Sub は SaveToImage Sub を呼び出します。SaveToImage サブルーチンは範囲を取得し、新しいページにチャートを作成してから、picture(objChart) を指定されたディレクトリに保存します。

LMpic 文字列変数は、保存したばかりの画像を呼び出し、それを HTML 本文に入力します。

Public Sub CreateEmail()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim FN, LN, EmBody, EmBody1, EmBody2, EmBody3 As String
Dim wb As Workbook
Dim ws As Worksheet

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

Set wb = ActiveWorkbook
Set ws = Worksheets("Sheet1")

Call SaveToImage


ws.Activate

LMpic = wb.Path & "\ClarityEmailPic.jpg'"

On Error GoTo cleanup
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" Then

        FN = Cells(cell.Row, "B").Value
        LN = Cells(cell.Row, "A").Value
        EmBody = Range("Email_Body").Value
        EmBody1 = Range("Email_Body1").Value
        EmBody2 = Range("Email_Body2").Value
        'EmBody3 = Range("Email_Body3").Value

        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = cell.Value
            .Subject = "Volt Clarity Reminder "
            .Importance = olImportanceHigh
            .HTMLBody = "<html><br><br><br>" & _
                            "<table border width=300 align=center>" & _
                                "<tr bgcolor=#FFFFFF>" & _
                                    "<td align=right>" & _
                                        "<img src='" & objRange & "'>" & _
                                    "</td>" & _
                                "</tr>" & _
                                "<tr border=0.5 height=7 bgcolor=#102561><td colspan=2></td></tr>" & _
                                "<tr>" & _
                                    "<td colspan=2 bgcolor=#E6E6E6>" & _
                                    "<body style=font-family:Arial style=backgroung-color:#FFFFFF align=center>" & _
                                            "<p> Dear " & FN & " " & LN & "," & "</p>" & _
                                            "<p>" & EmBody & "</p>" & _
                                            "<p>" & EmBody2 & "<i><font color=red>" & EmBody1 & "</i></font>" & "</p>" & _
                                    "</body></td></tr></table></html>"
            .Display  'Or use Display
        End With

        On Error GoTo 0
        Set OutMail = Nothing

    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Public Sub SaveToImage()
'
' SaveToImage Macro
'

    Dim DataObj As Shape
    Dim objChart As Chart
    Dim folderpath As String
    Dim picname As String
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    Set ws = Worksheets("Sheet2")

    folderpath = Application.ActiveWorkbook.Path & Application.PathSeparator 'locating & assigning current folder path
    picname = "ClarityEmailPic.jpg" 'image file name

    Application.ScreenUpdating = False

    Call ws.Range("Picture").CopyPicture(xlScreen, xlPicture) 'copying the range as an image

    Worksheets.Add(after:=Worksheets(1)).Name = "Sheet4" 'creating a new sheet to insert the chart
    ActiveSheet.Shapes.AddChart.Select
    Set objChart = ActiveChart
    ActiveSheet.Shapes.Item(1).Width = ws.Range("Picture").Width 'making chart size match image range size
    ActiveSheet.Shapes.Item(1).Height = ws.Range("Picture").Height

    objChart.Paste 'pasting the range to the chart
    objChart.Export (folderpath & picname) 'creating an image file with the activechart

    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete 'deleting sheet4
    Application.DisplayAlerts = True



End Sub
于 2015-05-29T18:51:05.557 に答える
0

一般に、電子メール画像はWebサーバーに保存され、SRCはそのサーバーを指します（http://...）。それらは電子メール自体に埋め込まれていません。

于 2013-03-13T14:25:17.690 に答える