Excel Forum

Code: Select all

Private Sub OpenEmailToSend()
Dim olLook          As Object            'Start MS Outlook
Dim olNewEmail      As Object            'New email in Outlook
Dim strContactEmail As String            'Contact email address
Dim strCustomer     As String            'Customer Name
Dim strSite         As String            'Site Name
    
    Windows("Daily MFG meeting report.xls").Activate
    Sheets("Image Send Mail").Select
    Application.CutCopyMode = xlCopy
    Selection.Copy

    strContactEmail = "xxxxx" 'ตัวแปร mail To
    strCc = "xxx" ' ตัวแปร mail CC
    strEmailText = strEmailText
    strEmailSubject = "Daily Manager Minute of Meeting on " & Format(Date, "DD MMM 'YYYY") & "_NAVANAKORN" '01 Nov.'12_NAVANAKORN"
    Set olLook = CreateObject("Outlook.Application")
    Set olNewEmail = olLook.createitem(0)
    strEmailText = "Dear all," & Chr$(13) & _
        Chr$(13) & "Pls. see attached  file  for  Daily manager meeting on  " & Format(Date, "DD - MMM - YYyy") & Chr$(13) & Chr$(13) & Chr$(13) & Chr$(13)
        
        With olNewEmail   'Attach template
            
            .To = strContactEmail '"Veerapong@mik-denshi.co.th"
            .CC = strCc
            .Body = strEmailText
            .Subject = strEmailSubject
            .Attachments.Add (StrPartName & StrFileName)
            .display

        End With

    Set olLook = Nothing
    Set olNewEmail = Nothing
   
End Sub

Code: Select all

Private Sub OpenEmailToSend()
    Dim olLook          As Object            'Start MS Outlook
    Dim olNewEmail      As Object            'New email in Outlook
    Dim strContactEmail As String            'Contact email address
    Dim strCustomer     As String            'Customer Name
    Dim strSite         As String            'Site Name
    
    Windows("Daily MFG meeting report.xls").Activate
    Sheets("Image Send Mail").Select
    Application.CutCopyMode = xlCopy
    Selection.Copy

    strContactEmail = "XXXx"
    strCc = "XXXX"
    strEmailText = strEmailText
    strEmailSubject = "Daily Manager Minute of Meeting on " & Format(Date, "DD MMM 'YYYY") & "_NAVANAKORN" '01 Nov.'12_NAVANAKORN"
    Set olLook = CreateObject("Outlook.Application")
    Set olNewEmail = olLook.createitem(0)
    strEmailText = "Dear all," & Chr$(13) & _
        Chr$(13) & "Pls. see attached  file  for  Daily manager meeting on  " & Format(Date, "DD - MMM - YYyy") & Chr$(13) & Chr$(13) & Chr$(13) & Chr$(13)
        
        With olNewEmail   'Attach template
            
            .To = strContactEmail '"Veerapong@mik-denshi.co.th"
            .CC = strCc
            .Body = strEmailText
            .Subject = strEmailSubject
            .Attachments.Add ("C:\ObjPic.gif")
            .display

        End With

    Set olLook = Nothing
    Set olNewEmail = Nothing
   
End Sub

Sub CopyObjToGIF()
    Dim obj As Object
    Dim cht As Excel.ChartObject
    Const strPath As String = "C:\"
    Application.ScreenUpdating = False
    Sheets("Image Send Mail").Shapes.Range( _
        Array("Picture 111")).Select
    Selection.Copy
    With Sheets("Image Send Mail")
        Set cht = .ChartObjects _
            .Add(0, 0, .Range("A1:O39").Width, .Range("A1:O39").Height)
    End With
    cht.Chart.Paste
    cht.Chart.Export strPath & "ObjPic.gif"
    cht.Delete
    Set cht = Nothing
    Set obj = Nothing
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub CopyObjToGIF()
    Dim obj As Object
    Dim cht As Excel.ChartObject
    Const strPath As String = "C:\"
    Application.ScreenUpdating = False
    Sheets("Image Send Mail").Shapes.Range( _
        Array("[color=#0000FF]Picture 111[/color]")).Select
    Selection.Copy
    With Sheets("Image Send Mail")
        Set cht = .ChartObjects _
            .Add(0, 0, .Range("A1:O39").Width, .Range("A1:O39").Height)
    End With
    cht.Chart.Paste
    cht.Chart.Export strPath & "ObjPic.gif"
    cht.Delete
    Set cht = Nothing
    Set obj = Nothing
    Application.ScreenUpdating = True
End Sub

Code: Select all

With olNewEmail   'Attach template
            
            .To = strContactEmail '"Veerapong@mik-denshi.co.th"
            .CC = strCc
            .Body = strEmailText
            .Subject = strEmailSubject
            .Attachments.Add ("C:\ObjPic.gif")
            .display

        End With

Code: Select all

With olNewEmail   'Attach template
            .To = strContactEmail '"Veerapong@mik-denshi.co.th"
            .CC = strCc
            .body = strEmailText
            .Subject = strEmailSubject
            .Attachments.Add (StrPartName & StrFileName)
            .Attachments.Add ("C:\ObjPic.gif")
            .HTMLBody = "<img src='cid:ObjPic.gif' height=480 width=360>"
            .Display
        End With