Click or drag to resize

VBScript 전체 소스

VBScript로 작성된 데이터베이스 기반 발송 예제 소스 코드입니다.

Copy
Option Explicit

'---- CursorTypeEnum Values ----
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3

'---- LockTypeEnum Values ----
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Const adLockBatchOptimistic = 4

'---- CommandTypeEnum Values ----
Const adCmdUnknown = &H0008
Const adCmdText = &H0001
Const adCmdTable = &H0002
Const adCmdStoredProc = &H0004
Const adCmdFile = &H0100
Const adCmdTableDirect = &H0200

'---- StreamTypeEnum Values ----
Const adTypeBinary = 1
Const adTypeText = 2

Dim connStr

connStr = "PROVIDER=SQLOLEDB;Data Source=(local)\TabsMailer4;Initial Catalog=TabsMailer4;User ID=sa;Password=!q7hfnl3sh62@;"

Call SimpleMail
Call SimpleAttachMail
Call ReadReceiptMail

Sub SimpleMail
    Dim conn, rs
    Dim fromName, fromAddr, toName, toAddr, subject, htmlbody, charset, schedule

    fromName = "기술지원"
    fromAddr = "help@tabslab.com"
    toName = "홍길동"
    toAddr = "hong@poporo.co.kr"
    subject = "테스트 메일입니다."
    htmlbody = "<html><body><h1>테스트 메일입니다.</h1></body></html>"
    charset = "euc-kr"
    schedule = Now

    Set conn = CreateObject("ADODB.Connection")
    conn.Open connStr

    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SendMessage", conn, adOpenDynamic, adLockPessimistic, adCmdTable

    rs.AddNew
    rs.Fields("sm_fromname").Value = fromName
    rs.Fields("sm_fromaddr").Value = fromAddr
    rs.Fields("sm_toname").Value = toName
    rs.Fields("sm_toaddr").Value = toAddr
    rs.Fields("sm_subject").Value = subject
    rs.Fields("sm_htmlbody").Value = htmlbody
    rs.Fields("sm_charset").Value = charset
    rs.Fields("sm_schedule").Value = schedule
    rs.Update

    rs.Close
    conn.Close
End Sub

Sub SimpleAttachMail
    Dim conn, rs, stream
    Dim fromName, fromAddr, toName, toAddr, subject, htmlbody, charset, attachFile, attachData

    fromName = "기술지원"
    fromAddr = "help@tabslab.com"
    toName = "홍길동"
    toAddr = "hong@poporo.co.kr"
    subject = "테스트 메일입니다."
    htmlbody = "<html><body><h1>테스트 메일입니다.</h1></body></html>"
    charset = "utf-8"
    attachFile = "tulip.jpg"

    Set stream = CreateObject("ADODB.Stream")
    stream.Type = adTypeBinary
    stream.Open
    stream.LoadFromFile attachFile
    attachData = stream.Read

    Set conn = CreateObject("ADODB.Connection")
    conn.Open connStr

    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SendMessage", conn, adOpenDynamic, adLockPessimistic, adCmdTable

    rs.AddNew
    rs.Fields("sm_fromname").Value = fromName
    rs.Fields("sm_fromaddr").Value = fromAddr
    rs.Fields("sm_toname").Value = toName
    rs.Fields("sm_toaddr").Value = toAddr
    rs.Fields("sm_subject").Value = subject
    rs.Fields("sm_htmlbody").Value = htmlbody
    rs.Fields("sm_charset").Value = charset
    rs.Fields("sm_attach1_name").Value = attachFile
    rs.Fields("sm_attach1_data").Value = attachData
    rs.Update

    rs.Close
    conn.Close
End Sub

Sub ReadReceiptMail
    Dim conn, rs
    Dim campaignId, msgId, fromName, fromAddr, toName, toAddr, subject, htmlbody, charset, rrlink

    campaignId = "{C9A93169-B1C9-4EB8-BE36-AA1412FC14A0}"
    msgId = GetGuid()
    fromName = "기술지원"
    fromAddr = "help@tabslab.com"
    toName = "홍길동"
    toAddr = "hong@poporo.co.kr"
    subject = "테스트 메일입니다."
    rrlink = "<img src='http://tabsmailer4.tabslab.com/trace/mailread.ashx?campaign=" & campaignId & "&msgid=" & msgId & "'>"
    htmlbody = "<html><body><h1>테스트 메일입니다.</h1>" & rrlink & "</body></html>"
    charset = "euc-kr"

    Set conn = CreateObject("ADODB.Connection")
    conn.Open connStr

    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SendMessage", conn, adOpenDynamic, adLockPessimistic, adCmdTable

    rs.AddNew
    rs.Fields("sm_cid").Value = campaignId
    rs.Fields("sm_msgid").Value = msgId
    rs.Fields("sm_fromname").Value = fromName
    rs.Fields("sm_fromaddr").Value = fromAddr
    rs.Fields("sm_toname").Value = toName
    rs.Fields("sm_toaddr").Value = toAddr
    rs.Fields("sm_subject").Value = subject
    rs.Fields("sm_htmlbody").Value = htmlbody
    rs.Fields("sm_charset").Value = charset
    rs.Update

    rs.Close
    conn.Close
End Sub

Function GetGuid() 
    Dim typeLib
    Set typeLib = CreateObject("Scriptlet.TypeLib") 
    GetGuid = Left(CStr(typeLib.Guid), 38) 
    Set typeLib = Nothing 
End Function