dongkaka88
Thành viên mới
- Tham gia
- 6/5/17
- Bài viết
- 8
- Được thích
- 1
- Giới tính
- Nam
Hiện mình có code tự động gửi mail outlook từ excel như dưới, như chỉ hoạt động với đúng Sheet 1. Tức là button SendOutlook ở sheet 1 thì mới hoạt động được. Mình muốn di chuyển button SendOutlook sang sheet 2, nhưng nó bị lỗi, không hoạt động được.
Các bạn cho xin cao kiến giúp mình với.
Các bạn cho xin cao kiến giúp mình với.
Mã:
Sub SendOutlook()
Dim OutApp, OutMail As Object
Dim EmpName, Subj, MesgBefore, MesgAfter, Attach, Email, Link, PicFilename As String
Dim PicRng As Range
Dim LastRow, PicWidth, PicHeight As Long
Dim PicChart As Chart
On Error Resume Next
With Sheet1
Set PicRng = .Range("A1:E24")
EmpName = .Range("H6").Value 'Ten ban ve
Link = .Range("H12").Value 'Link ban ve
Email = .Range("H13").Value 'Dia chi Email nguoi nhan
Subj = .Range("H6").Value 'Chu de thu
MesgBefore = .Range("H8").Value 'Noi dung truoc thu
MesgAfter = .Range("H11").Value 'Noi dung sau thu
MesgBefore = Replace(Replace(Replace(MesgBefore, "#EmpName#", EmpName), "#Link#", Link), Chr(10), "<br>")
MesgAfter = Replace(Replace(Replace(MesgAfter, "#EmpName#", EmpName), "#Link#", Link), Chr(10), "<br>")
PicFilename = ThisWorkbook.Path & "\AnhCvPhbv.jpg" 'Ten file anh
On Error Resume Next
If Dir(PicFilename) > 0 Then Kill (PicFilename) 'Delete any picture that has the same name in the same location first
On Error GoTo 0
On Error Resume Next
PicRng.CopyPicture xlScreen, xlBitmap 'Create a bitmap image of the report range and copy the picture
On Error GoTo 0
'Create a new Temporary Chart
With ActiveSheet.ChartObjects.Add(Left:=PicRng.Left, Top:=PicRng.Top, Width:=PicRng.Width, Height:=PicRng.Height)
.Name = "AnhCvPhbv"
.Activate
PicWidth = PicRng.Width
PicHeight = PicRng.Height
End With
ActiveChart.Paste 'Past the Picture in the pie chart
ActiveSheet.ChartObjects("AnhCvPhbv").Chart.Export ThisWorkbook.Path & "\AnhCvPhbv.jpg"
.Shapes("AnhCvPhbv").Delete 'Delete Picture
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
If Email = Empty Then
MsgBox "Chua cap nhat dia chi email"
Exit Sub
Else
.To = Email
On Error Resume Next
.Attachments.Add PicFilename, 1, 0
On Error GoTo 0
.Subject = Subj
.HTMLBody = .HTMLBody & MesgBefore & "<br>" _
& "<img src='cid:AnhCvPhbv.jpg'" & "width='" & PicWidth & "' height='" & PicHeight & "'><br>" _
& "<br>" & MesgAfter & "</font></span>"
'.HTMLBody = .HTMLBody & MesgBefore & "<br><br>" _
& RangetoHTML(Sheet1.Range("D14:H37")) & "<br>" _
& "<br>" & MesgAfter & "</font></span>"
.Send 'Change to .Send to Send emails without displaying them first
End If
End With
On Error GoTo 0
Set OutMail = Nothing
End With
End Sub
) ko giống sgk nhưng vẫn chạy tốt 
