OfficeTutor.com
배움터 나눔터 교육센터 오튜장터
 통합검색  
  Home > 나눔터 > 엑셀 > 묻고답하기
엑셀
워드
액세스
파워포인트
아웃룩
프런트페이지
인포패스
원노트
비지오
쉐어포인트
포토드로우
퍼블리셔
오피스공통
MVP 안내
MVP 명예의 전당
MVP 카페

 

 

 

 
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 dew (dewdrop)

추천:  0
파일:     질문(241)_Ans.xlsm (29.2KB) 조회:  258
제목:   [RE]한개의 엑셀파일을 여러명에게 메일보내기
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007):

* 아래줄에 질문을 작성하세요 >>

한개의 엑셀파일을 잘라서 일부씩 여러명에게 메일보내기가 가능한지?
꼭 가능했으면 좋겠습니다.

질문파일 봐주세요.
==============[시커미소님 글에 대한 답변입니다]==============

첨부화일 참고하세요....

Sub Mail_Range()
    Dim wbk As Workbook, wbkDest As Workbook
    Dim rDb As Range, rSoc As Range, rCri As Range, rX As Range
    Dim sFilePath As String, sFileName As String
    Dim sExt As String
    Dim lFileFormat As Long
    Dim OutApp As Object, OutMail As Object
    Dim sSubject As String
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set wbk = ActiveWorkbook
    Set rDb = wbk.Worksheets("내역").Range("A2").CurrentRegion
    Set rCri = wbk.Worksheets("Email주소").Range("A2").CurrentRegion
    Set rCri = rCri.Offset(1).Resize(rCri.Rows.Count - 1).Columns(4)
    
    If rDb.Parent.AutoFilterMode Then rDb.Parent.AutoFilterMode = False
    
    If Val(Application.Version) < 12 Then
        sExt = ".xls": lFileFormat = xlWorkbookNormal       ' Excel 97-2003
    Else
        sExt = ".xlsx": lFileFormat = xlOpenXMLWorkbook     ' Excel 2007-2016
    End If
    
    sFilePath = Environ$("temp") & Application.PathSeparator
    Set OutApp = CreateObject("Outlook.Application")
    
    For Each rX In rCri.Cells
        Set OutMail = OutApp.CreateItem(0)
        rDb.AutoFilter Field:=5, Criteria1:=rX.Value
        
        Set rSoc = rDb.SpecialCells(xlCellTypeVisible)
        
        Set wbkDest = Workbooks.Add(xlWBATWorksheet)
        sFileName = rX.Value & "_" & Format(Now, "yyyymmdd_hhmmss")
        
        sSubject = rX.Offset(, -2) & "_" & rX.Offset(, -1) & "_" & rX.Offset(, 0)
        
        rSoc.Copy
        With wbkDest
            With .Sheets(1)
                .Cells(1).PasteSpecial Paste:=xlPasteColumnWidths
                .Cells(1).PasteSpecial Paste:=xlPasteValues
                .Cells(1).PasteSpecial Paste:=xlPasteFormats
                .Cells(1).Select
            End With
            Application.CutCopyMode = False
            
            .SaveAs sFilePath & sFileName & sExt, lFileFormat
            On Error Resume Next
            With OutMail
                .To = rX.Offset(, -3)
                .CC = ""
                .Bcc = ""
                .Subject = sSubject
                .Body = sSubject & " 담당자의 현황 리스트입니다."
                .Attachments.Add wbkDest.FullName
                
                '.Send      ' 메일 보내기
                .Display
                
            End With
            On Error GoTo 0
            .Close False
        End With
        
        Set OutMail = Nothing
        Kill sFilePath & sFileName & sExt
    Next
    
    If rDb.Parent.AutoFilterMode Then rDb.Parent.AutoFilterMode = False
    
    Set OutApp = Nothing
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
 
[불량 게시물 신고]  
시커미소dew님

감사합니다.
업무에 적용하니 효율성이 대단히 높습니다.

다시한번 감사드립니다.
02-12 (15:04)
삭제 ■신고
        
  

작성일 : 2019-02-12(13:58)
최종수정일 : 2019-02-12(13:58)
 


 ◎ 관련글

  제 목   작성자   날짜
한개의 엑셀파일을 여러명에게 메일보내기 시커미소 2019-02-11
[RE]한개의 엑셀파일을 여러명에게 메일보내기 dew 2019-02-12

 
 
회사소개 | 이용약관 | 개인정보 처리방침 | 회원정보수정 | 교육신청 및 문의 | 이메일무단수집거부 위로

오피스튜터 블로그 오피스튜터페이스북 오피스튜터유투브
110-722 서울 종로구 세종대로23길 47, 601-74 ㈜오피스튜터 ☎1544-4102 대표이사 : 전경수
개인정보관리책임자 : 이희진(privacy@officetutor.com) 사업자등록번호 120-86-14501
통신판매업신고 2013-서울종로-0547
norton
Copyright ⓒ OfficeTutor.com 이 페이지의 저작권은 ㈜오피스튜터와 콘텐츠 제공자에게 있습니다. 무단 복제를 금합니다.
Microsoft 및 Office 로고는 미국, 대한민국 및/또는 기타 국가에서의 Microsoft Corporation 등록 상표 또는 상표입니다.