급여명세서 PDF 뜨고 자동으로 메일 보내기

지인중에 한분이 급여일 하는데 노가다 하고있어서

편히하라고 만들어 줬습니다.

​

샘플 첨부해놓습니다.

아주 먼 옛날 제가 올려놓은 급여매크로에서 업데이트 버전이라고 생각하심 되겠습니다.

​

요는 엑셀로 급여대장 작성하면

인별로 PDF를 저장하고, 그 PDF를 직원 메일로 보내주는 매크로입니다.

​

사전작업 해야할거는 outlook 메일 가입하셔야 한다는게 있습니다.

아래 붉은 부분만 매핑시켜서 바까주심 되겠습니다.

​

요즘 어느정도 규모있는 회사면 다 시스템으로 구현되어있을텐데

막 스타트업이나, 이런거 돈주고 하기 아깝다 하시는분들

쓰시면 되겠습니다.

​

테스트해보니깐 잘 되네요 껄껄. 급여명세 양식이 이렇게 쓰면 안될텐데, 지인이 그대로 해달라해서 그냥 썼습니다. 사용하시는분들은 최근 법 바뀐거에 맞춰서 양식 바꿔서 사용하심 되겠습니다.

​

작업하시고 버튼 누르면 아래처럼 메시지가 뜨는데, 보낼사람은 Y하고 아니면 N 하시면됩니다. 인별로 묻습니다.

​

​

 

 

Sub start()

Dim r As Long

Dim shtPrint As Worksheet

Dim shtData As Worksheet

Dim rng(1 To 11) As Range

Dim fileName As String

Dim savePath As String

Dim folderPath As String

Dim mailApp As Object

Dim mailItem As Object

Dim emailAddress As String

Dim answer As VbMsgBoxResult

​

Set shtPrint = ThisWorkbook.Worksheets("출력물") ' 출력 양식

Set shtData = ThisWorkbook.Worksheets("급여데이터") ' 데이터 시트

​

' 출력물에 해당하는 셀 지정

Set rng(1) = shtPrint.Range("G4") ' 성명

Set rng(2) = shtPrint.Range("E7") ' 기본급

Set rng(3) = shtPrint.Range("K7") ' 국민연금

Set rng(4) = shtPrint.Range("K8") ' 건강보험

Set rng(5) = shtPrint.Range("K9") ' 장기요양보험

Set rng(6) = shtPrint.Range("K10") ' 고용보험

Set rng(7) = shtPrint.Range("K11") ' 소득세

Set rng(8) = shtPrint.Range("K12") ' 지방소득세

Set rng(9) = shtPrint.Range("E18") ' 지급총액

Set rng(10) = shtPrint.Range("J18") ' 공제총계

Set rng(11) = shtPrint.Range("G19") ' 실지급액

​

' 저장 경로 확인 및 폴더 생성

folderPath = "C:\급여명세서\"

If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath

​

' Outlook Application 객체 생성

Set mailApp = CreateObject("Outlook.Application")

​

r = 0

Do While shtData.Cells(2 + r, 1).Value <> ""

' 데이터 매핑

rng(1).Value = shtData.Cells(2 + r, 1).Value ' 성명

rng(2).Value = shtData.Cells(2 + r, 3).Value ' 기본급

rng(3).Value = shtData.Cells(2 + r, 5).Value ' 국민연금

rng(4).Value = shtData.Cells(2 + r, 6).Value ' 건강보험

rng(5).Value = shtData.Cells(2 + r, 7).Value ' 장기요양보험

rng(6).Value = shtData.Cells(2 + r, 8).Value ' 고용보험

rng(7).Value = shtData.Cells(2 + r, 9).Value ' 소득세

rng(8).Value = shtData.Cells(2 + r, 10).Value ' 지방소득세

rng(9).Value = shtData.Cells(2 + r, 4).Value ' 지급총액

rng(10).Value = shtData.Cells(2 + r, 15).Value ' 공제총계

rng(11).Value = shtData.Cells(2 + r, 16).Value ' 실지급액

​

' 파일명: 성명 기반으로, 특수문자 제거

fileName = Replace(rng(1).Value, "\", "_")

fileName = Replace(fileName, "/", "_")

fileName = Replace(fileName, ":", "_")

fileName = Replace(fileName, "*", "_")

fileName = Replace(fileName, "?", "_")

fileName = Replace(fileName, """", "_")

fileName = Replace(fileName, "<", "_")

fileName = Replace(fileName, ">", "_")

fileName = Replace(fileName, "|", "_")

fileName = folderPath & fileName & ".pdf"

​

' PDF로 저장

shtPrint.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, Quality:=xlQualityStandard

​

' 이메일 주소 가져오기 (Q열로 변경: 17번째 열)

emailAddress = shtData.Cells(2 + r, 17).Value

 

If emailAddress <> "" Then

' 보내기 전에 사용자에게 확인

answer = MsgBox(rng(1).Value & " 님에게 이메일을 발송하시겠습니까?" & vbCrLf & _

"이메일 주소: " & emailAddress, vbYesNo + vbQuestion, "메일 발송 확인")

 

If answer = vbYes Then

' 메일 생성 및 발송

Set mailItem = mailApp.CreateItem(0)

With mailItem

.To = emailAddress

.Subject = rng(1).Value & "님 급여명세서 발송드립니다."

.Body = rng(1).Value & "님, 안녕하세요." & vbCrLf & vbCrLf & _

"첨부된 파일은 " & rng(1).Value & "님의 급여명세서입니다." & vbCrLf & vbCrLf & _

"확인 부탁드립니다." & vbCrLf & vbCrLf & _

"감사합니다."

.Attachments.Add fileName

.Send

End With

Else

' 사용자가 No를 누르면 건너뜀

End If

End If

 

r = r + 1

Loop

​

MsgBox "모든 급여명세서 PDF 저장 및 이메일 발송이 완료되었습니다!", vbInformation

End Sub

 

급여명세서 매크로 ver 02.xlsm

0.03MB