Hai sobat Media,
Setelah sekian lama blog ini tidak ter-update content baru, kini saatnya saya ingin membagikan tips mengenai Macro di Excel. Beberapa waktu yang lalu, seorang rekan memberikan pertanyaan seputar pemakaian macro pada Excel. Secara garis besar, rekan saya ingin meng-email-kan hasil pencatatan tagihan yang statusnya sudah / akan jatuh tempo. Sobat Media bisa lihat screenshot berikut ini :


Terlihat dari screenshot ini bahwa ada flow proses yang harus dilakukan yaitu sebagai berikut :
1. Filter data berdasarkan 'Status' di Kolom F
2. Filter data berdasarkan 'Due Date' di Kolom D
3. Mengirimkan data hasil filter melalui email saat H+0 Due Date atau H-7 Due Date.

Dari flow diatas, saya mencoba menyusun macro di excel untuk melakukan proses 2 filtering kriteria data dan proses mengirimkan hasil filter yang akan ditempelkan pada body email kita nantinya.

Untuk coding hal tersebut, Sobat Media dapat melihat pada :

Coding Macro:
Sub Mail_Selection_Range_Outlook_Body()
'Filtering data by Criteria first, then by Date

Dim lngStart As Long, lngEnd As Long
lngStart = Range("I2").Value 'start date begin date(now)-7
lngEnd = Range("J2").Value 'end date(now)

'Range date tobe Filtered
Range("$A$2:$E$7").AutoFilter field:=3, _
Criteria1:=">=" & lngStart, _
Operator:=xlAnd, _
Criteria2:="<=" & lngEnd

ActiveSheet.Range("$A$2:$E$7").AutoFilter field:=5, Criteria1:="OVERDUE"

'Define Range / Active Sheet @Sheet1 Range B2 till F12
'Export to HTML Format
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next

Set rng = Sheets("Sheet1").Range("B2:F12").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 = "AddressMail@provider.com"
.CC = ""
.BCC = ""
.Subject = "Report Overdue"
.HTMLBody = RangetoHTML(rng)
.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)

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
Sebenarnya ada beberapa cara untuk mengirimkan hasil yang dimaksud yaitu membuat hasil fiter di excel menjadi HTML dan mem-paste nya ke dalam body email. Selain cara tersebut, dapat juga hasil filter di excel dikirimkan semua langsung as attachment pada email kita. Coding yang sudah dituliskan diatas, dapat dijadikan Macro dan dibuatkan command button pada excel, sehingga saat command button di klik, macro akan mulai berjalan.


Terlihat dari screenshot ini, coding dilekatkan pada command button 'Filter And Send' dan saya menambahkan funsi pembacaan data tanggal pada I2 (H-7) dan pada J2 (H+0). Ilustrasi prosesnya menjadi :
Bilamana command button di klik, maka data akan di filter berdasarkan Status dan Due Date (H-7). Setelah hasilnya muncul, baru akan di di import menjadi HTML untuk dapat di lekatkan pada body email. Sehingga hasil yang akan di email menjadi seperti screenshot dibawah ini :


Nah, kita sekarang bisa mulai mengirimkan email sesuai dengan kriteria filtering yang kita butuhkan. Semoga sedikit info ini dapat membantu Sobat Media bila mempunyai permasalahan yang serupa.

Selamat mencoba,