Sub sendMailforCheck()
    Dim Subj As String
    Dim EmailAddr As String, Emailcc As String
    Dim msg As String
    Dim attachFileName As String
    Dim dayMark As String, qjdDeliverNo As String
    
'    qjdDeliverNo = ActiveWorkbook.ActiveSheet.Range("J17").Value
    qjdDeliverNo = Evaluate("'C:\Users\huyg\Desktop\[操作.xlsm]日週報'!$J$17")
    
    dayMark = InputBox("請輸入日期識別符號,格式如:20150808", , Format(Date - 1, "YYYYMMDD"))
    
    Subj = "forcheck" & dayMark & "及配送量"
    EmailAddr = "*************"
    Emailcc = "******************"
    msg = "Hi，All <br /><br />"
    msg = msg & "forcheck" & dayMark & ",請查收"
    msg = msg & "<br />" & dayMark & "量為:<font color='red'>" & qjdDeliverNo & "</font>"
    attachFileName = "E:\03 日報\" & dayMark & "forcheck.xls"
    
    Call sendMailFor(Subj, EmailAddr, Emailcc, msg, attachFileName)
End Sub

Sub sendMailFor(subject As String, EmailAddr As String, Emailcc As String, msg As String, attachFileName As String)
    
    attachFileArr = VBA.Split(attachFileName, "#")
    
    Application.ScreenUpdating = False
    'Create Outlook object
    Set outlookapp = CreateObject("Outlook.Application")
    On Error Resume Next
    
    'Send this Email?
    Ans = MsgBox("Send Email To:" & EmailAddr & "?", vbYesNo, "Seng Email?")
    If Ans = vbNo Then
        Exit Sub
    End If

    'Create Mail Item and send it
    Set MItem = outlookapp.CreateItem(olMailItem) 'olMailItem
    With MItem
        .BodyFormat = Outlook.OlBodyFormat.olFormatHTML 'olFormatHTML
        .To = EmailAddr
        .cc = Emailcc
        .subject = subject
'        .Body = Msg
        For i = 0 To UBound(attachFileArr)
            .Attachments.Add attachFileArr(i) 
        Next
        .HTMLBody = .HTMLBody & "<p style='font-family:verdana;line-height:1px;margin:1px'><font face='微軟雅黑';style='font-size: 14px'>" + _
                    msg + "</font></p>" '' "<img src='E:\Chart1.png'>Excel <wbr>VBA操作Outlook傳送郵件"
        .Display
        '.Send
'        .Save 'to Drafts folder
    End With
     
    Application.ScreenUpdating = True
    On Error GoTo 0
    Set outlookapp = Nothing
 
  '   Delete the file
  'Kill MyFileName
    
End Sub