Custom Signature di Ms Outlook secara random

Bagi anda yang bergelut dengan Ms Outlook tiap hari tentunya sudah tidak aneh dengan signature. Signature biasanya berisi nama pengirim, alamat, telp, dan lainnya. Terlepas dari itu, untuk sebagian kalangan, signature juga digunakan sebagai alat promosi dan marketing. Namun kekurangannya signaturenya terkesan statis dan hanya itu-itu saja, terlebih bila mengonta-ganti kata-katanya, kita harus menggantinya dengan manual dengan mengedit signaturenya.

Untuk itu, saya akan share untuk membuat signature secara random. Konsepnya adalah dengan menggunakan bantuan dari VBA macro dan text file. Berikut langkah-langkahnya :

1. Buka VBA apps di Ms Outlook dengan menekan tombol Alt+F11



Copy paste VBA script dibawah ini :

Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    ' Validate that the item sent is an email.

    'If Item.Class <> olMail Then Exit Sub

    Const SearchString = "%Random_Line%"

    Const QuotesFile = "c:\random_quotes.txt"

    If InStr(Item.Body, SearchString) Then

'        If FileOrDirExists(QuotesFile) = False Then

'            MsgBox ("Quotes file wasn't found! Canceling message")

'            Cancel = True

'        Else

            Dim lines() As String

            Dim numLines As Integer

            numLines = 0

            ' Open the file for reading

            Open QuotesFile For Input As #1

            ' still cannot open the quotes... why?

            ' Go over each line in the file and save it in the array + count it

            Do Until EOF(1)

                ReDim Preserve lines(numLines + 1)

                Line Input #1, lines(numLines)

                numLines = numLines + 1

            Loop

            Close #1

            

            ' Get the random line number

            Dim randLine As Integer

            randLine = Int(numLines * Rnd()) + 1

            ' Insert the random quote

            Item.HTMLBody = Replace(Item.HTMLBody, SearchString, lines(randLine))

            Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", randLine)

'       End If

    End If

End Sub

Function FileOrDirExists(PathName As String)

    Dim iTemp As Integer

    On Error Resume Next

    iTemp = GetAttr(PathName)

    Select Case Err.Number

    Case Is = 0

        FileOrDirExists = True

    Case Else

        FileOrDirExists = False

    End Select

    On Error GoTo 0

End Function

Tidak perlu dimengerti semua, cukup perhatikan dua varibale dibawah ini yang harus diganti :

    Const SearchString = "%Random_Line%"
    Const QuotesFile = "c:\random_quotes.txt"

Tuliskan variable %Random_Line% dibagian mana teks anda akan tampil di signature.
Kemudian anda siapkan satu file teks dengan nama random_quotes.txt dan simpan di drive C:
atau di manapun terserah anda.

Selamat anda sudah berhasil membuat random quotes. Silahkan tes signature baru anda dengan mengirim email dan lihat hasilnya di sent item.