BLOG main image
분류 전체보기 (42)
잡담 (6)
활용 (17)
language (3)
project (14)
design (2)
자료정리 (0)
결혼 준비 (0)
sarl pyver
sarl pyver
geometry dash apk zippy
geometry dash apk zippy
geometry dash apk full
geometry dash apk full
cheap christian louboutin
cheap christian louboutin
herehoju.com
herehoju.com
234,297 Visitors up to today!
Today 4 hit, Yesterday 12 hit
daisy rss
tistory 티스토리 가입하기!
'2012/11'에 해당되는 글 1건
2012.11.13 14:41
총무 회람에 입금을 하지 않은 사람들에게만 메일을 보내는 엑셀 매크로를 만들었다.
회사 특성상 이메일 보내기에 대한 리눅스 서버나 다른 동작이 어려운 상태라서 엑셀과 아웃룩을 통해서 메일을 보낸다.
엑셀에서 타이틀을 제외한 내용만 선택해서 매크로를 실행하면 된다.




Sub SendDemmanddingMail(address As String, name As String _
                        , moneyPromise As String _
                        , moneyReceived As String _
                        , moneyRemain As String)
    Dim title As String
    Dim msgBody As String
    
    'title
    title = "[총무] 회람 금액 송금 확인 부탁드립니다."
    'body
    msgBody = msgBody & "안녕하세요 이승한 사원입니다." & "<br/>"
    msgBody = msgBody & "회람에 " & moneyPromise & "만원을 입금해 주시기로 하셨는데요. "
    msgBody = msgBody & "현재 입금액 " & moneyReceived & "만원으로 "
    msgBody = msgBody & "나머지 " & moneyRemain & "만원이 확인 안되고 있습니다." & "<br/>"
    msgBody = msgBody & "확인 부탁드립니다." & "<br/>"
    msgBody = msgBody & "" & "<br/>"
    msgBody = msgBody & "계좌번호 : ~~~~" & "<br/>"
    msgBody = msgBody & "이승한 사원 드림" & "<br/>"
    'print
    Debug.Print "adress  : " + address
    Debug.Print "Title   : " + title
    Debug.Print "msgBody : " + msgBody
    Debug.Print "----------------------------------------"
    
    'send email
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    On Error Resume Next
    With OutMail
        .To = address
        .Subject = title
        .HTMLBody = msgBody
        .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Sub DemandMoney()
    Dim msgBody As String
    For Each r In Selection.Rows
        If Cells(r.Row, 4).Value > 0 Then
            SendDemmanddingMail Cells(r.Row, 5).Value _
                , Cells(r.Row, 5).Value _
                , Cells(r.Row, 2).Value _
                , Cells(r.Row, 3).Value _
                , Cells(r.Row, 4).Value
        End If
    Next r
End Sub


Name
Password
Homepage
Secret
prev"" #1 next