2016-09-30 2 views
0

Excel 시트에서 데이터를 가져 와서 HTML로 변환하고 전자 메일로 전송하는 코드를 실행하고 있습니다. 아래 방법 나는 사용한다 :Excel 테이블을 HTML로 내보내기

'replace html body' 
htmlString = Replace(htmlString, "#FIELD1#", ws.Range("D5").value) 
htmlString = Replace(htmlString, "#FIELD2#", ws.Range("C6").value) 

이제 내가 같은 형식으로 HTML에 붙여 넣기를 복사하고자하는 완전한 테이블 (등 테두리, 글꼴,)

누군가가 도움을 주시기 바랍니다 수 있습니다 그것을하는 방법에?

+0

론 드 Bruin입니다 님의 블로그 [메일의 본문에 메일 범위/선택] (http://www.rondebruin.nl/win/s1/outlook/bmail2.htm) 모든 코드와 예제를 가지고 필요한 것. –

답변

0

답변은 메일 클라이언트에 따라 다소 다릅니다. Outlook은 VBA와 밀접하게 통합되어 있습니다. 일반 메일 클라이언트를 사용하는 경우에도 작업을 수행 할 수는 있지만 문제가 발생할 수 있습니다.

Excel에서 복사하여 Outlook에서 HTML로 붙여 넣으려면이 답변이 이미 있습니다 : Copying values from excel to body of outlook email vb.net.

일반 이메일을 사용하여 보내려는 경우 아래 내 대답을 참조하십시오. 나는 이것이 HTML로 잘 작동한다고 믿는다. (메일 클라이언트가 전달 된 HTML에 만족하지 않으면 텍스트 파일로 변환하여 변환 할 수 있습니다. 텍스트 파일의 경우 개발자 리본에서 직접 매크로를 녹음 할 수 있습니다. 녹음을 시작하고 다른 이름으로 저장을 사용하십시오. 텍스트 파일로 저장하십시오.)

아래에 3 개의 하위/기능이 있습니다. 내 코드 인 HTMLExport를 테스트했습니다. SendEMail은 Chip Pearson의 사이트에서 왔으며 잘 작동합니다. http://www.cpearson.com/Excel/EMail.aspx을 : 나는 단순히 이전 2.

Sub ExcelToHTMLToEMail(BodyRngName as string, 
     Subject As String, _ 
     FromAddress As String, _ 
     ToAddress As String, _ 
     SMTP_Server As String, _ 
     Optional Attachments As Variant = Empty) 

    Dim BodyFileName As String 

    BodyFileName = "C:\temp.htm" 

    HTMLExport RngName, BodyFileName 

    SendEMail Subject, _ 
     FromAddress, _ 
     ToAddress, _ 
     "", _ 
     SMTP_Server, _ 
     BodyFileName, _ 
     Optional Attachments 
End Sub 

Sub HTMLExport(RngName as string, _ 
    HtmlFileName as String, _ 
    Optional PageTitle as string = "") 
    ' 
    ' HTMLExport Macro 
    ' 
    Range(RngName).Select 
    With ActiveWorkbook.PublishObjects.Add(xlSourceRange, HtmlFileName , _ 
     "Sheet1 (7)", RngName, xlHtmlStatic, , "MyPageTitle") 
     .Publish (True) 
     .AutoRepublish = False 
    End With 
End Sub 

당신은 칩 피어슨에서 엑셀에서 이메일을 보내는 코드를 찾을 수를 호출 ExcelToHTMLToEMail을 테스트하지 않았다. 이 웹 사이트에는 Excel VBA 코드의 거대한 저장소가 있습니다. 소개

응용 프로그램에서 전자 메일을 보내는 기능을 추가하는 것은 어렵지 않습니다. 제목 만 있지만 내용이없는 통합 문서를 보내려면 모두 ThisWorkbook.SendMail을 사용할 수 있습니다. 그러나 메시지 본문에 텍스트를 포함하거나 추가 파일을 첨부 파일로 포함하려면 VBA 코드가 필요합니다. 이 페이지는 SendEmail이라는 함수를 설명합니다.이 함수는 VBA에 친숙한 멋진 함수로 세부 정보를 마무리합니다. 여기에서 코드 파일을 다운로드 할 수 있습니다.

함수의 정의는 다음과 같습니다

주제 이메일의 제목입니다
Function SendEMail(Subject As String, _ 
     FromAddress As String, _ 
     ToAddress As String, _ 
     MailBody As String, _ 
     SMTP_Server As String, _ 
     BodyFileName As String, _ 
     Optional Attachments As Variant) As Boolean 

.

FromAddress는 귀하의 이메일 주소입니다.

ToAddress는 이메일을 보낼 주소입니다. 세미콜론으로 이메일 주소를 구분하여 여러 수신자에게 메시지를 보낼 수 있습니다.

MailBody는 메시지 본문이 될 텍스트입니다. 이 필드를 비워두고 BodyFileName이 텍스트 파일의 이름을 지정하면 메시지 본문은 BodyFileName이라는 파일의 모든 텍스트가됩니다. BodyFileName과 MailBody가 모두 비어 있으면 본문없이 메시지가 전송됩니다.

SMTP_Server는 보내는 메일 서버의 이름입니다.

BodyFileName은 메시지 본문으로 사용될 텍스트 파일의 이름입니다. MailBody가 비어 있지 않으면이 매개 변수는 무시되고 파일은 본문으로 사용되지 않습니다. MailBody와 BodyFileName이 모두 비어 있지 않으면 MailBody의 내용이 본문으로 사용되고 BodyFileName은 무시됩니다.

첨부 파일은 메시지에 첨부 할 단일 파일 이름 또는 파일 이름의 배열입니다. 파일 중 하나를 첨부하는 중 오류가 발생하면 처리가 나머지 파일과 함께 계속되고 전자 메일이 전송됩니다.

이 함수는 성공하면 True를 반환하고 오류가 발생하면 False를 반환합니다.

코드에는 Windows 2000 Library 용 Microsoft CDO에 대한 참조가 필요합니다. 이 파일의 일반적인 파일 위치는 C : \ Windows \ system32 \ cdosys.dll입니다. 이 성분의 GUID는

규범

코드 (Code)는 아래와 같다 주요 = 1 부 = 0

SectionBreak와 {CD000000-8B95-11D1-82DB-00C04FB1625D}이다. 여기에서 코드 파일을 다운로드 할 수 있습니다.

Function SendEMail(Subject As String, _ 
     FromAddress As String, _ 
     ToAddress As String, _ 
     MailBody As String, _ 
     SMTP_Server As String, _ 
     BodyFileName As String, _ 
     Optional Attachments As Variant = Empty) As Boolean 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' SendEmail Function 
' By Chip Pearson, [email protected] www.cpearson.com 28-June-2012 
' 
' This function sends an email to the specified user. 
' Parameters: 
' Subject:  The subject of the email. 
' FromAddress: The sender's email address 
' ToAddress:  The recipient's email address or addresses. 
' MailBody:  The body of the email. 
' SMTP_Server: The SMTP-Server name for outgoing mail. 
' BodyFileName: A text file containing the body of the email. 
' Attachments  A single file name or an array of file names to 
'     attach to the message. The files must exist. 
' Return Value: 
' True if successful. 
' False if failure. 
' 
' Subject may not be an empty string. 
' FromAddress must be a valid email address. 
' ToAddress must be a valid email address. To send to multiple recipients, 
' use a semi-colon to separate the individual addresses. If there is a 
' failure in one address, processing terminates and messages are not 
' send to the rest of the recipients. 
' If MailBody is vbNullString and BodyFileName is an existing text file, the content 
' of the file named by BodyFileName is put into the body of the email. If 
' BodyFileName does not exist, the function returns False. The content of 
' the message body is created by a line-by-line import from BodyFileName. 
' If MailBody is not vbNullString, then BodyFileName is ignored and the body 
' is not created from the file. 
' SMTP_Server must be a valid accessable SMTP server name. 
' If both MailBody and BodyFileName are vbNullString, the mail message is 
' sent with no body content. 
' Attachments can be either a single file name as a String or an array of 
' file names. If an attachment file does not exist, it is skipped but 
' does not cause the procedure to terminate. 
' 
' If you want to send ThisWorkbook as an attachment to the message, use code 
' like the following: 
' ThisWorkbook.Save 
' ThisWorkbook.ChangeFileAccess xlReadOnly 
' B = SendEmail(_ 
'  ... parameters ... 
'  Attachments:=ThisWorkbook.FullName) 
' ThisWorkbook.ChangeFileAccess xlReadWrite 
' 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' Required References: 
' -------------------- 
' Microsoft CDO for Windows 2000 Library 
'  Typical File Location: C:\Windows\system32\cdosys.dll 
'  GUID: {CD000000-8B95-11D1-82DB-00C04FB1625D} 
'  Major: 1 Minor: 0 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

Dim MailMessage As CDO.Message 
Dim N As Long 
Dim FNum As Integer 
Dim S As String 
Dim Body As String 
Dim Recips() As String 
Dim Recip As String 
Dim NRecip As Long 

' ensure required parameters are present and valid. 
If Len(Trim(Subject)) = 0 Then 
    SendEMail = False 
    Exit Function 
End If 

If Len(Trim(FromAddress)) = 0 Then 
    SendEMail = False 
    Exit Function 
End If 

If Len(Trim(SMTP_Server)) = 0 Then 
    SendEMail = False 
    Exit Function 
End If 

' Clean up the addresses 
Recip = Replace(ToAddress, Space(1), vbNullString) 
If Right(Recip, 1) = ";" Then 
    Recip = Left(Recip, Len(Recip) - 1) 
End If 
Recips = Split(Recip, ";") 


For NRecip = LBound(Recips) To UBound(Recips) 
    On Error Resume Next 
    ' Create a CDO Message object. 
    Set MailMessage = CreateObject("CDO.Message") 
    If Err.Number <> 0 Then 
     SendEMail = False 
     Exit Function 
    End If 
    Err.Clear 
    On Error GoTo 0 
    With MailMessage 
     .Subject = Subject 
     .From = FromAddress 
     .To = Recips(NRecip) 
     If MailBody <> vbNullString Then 
      .TextBody = MailBody 
     Else 
      If BodyFileName <> vbNullString Then 
       If Dir(BodyFileName, vbNormal) <> vbNullString Then 
        ' import the text of the body from file BodyFileName 
        FNum = FreeFile 
        S = vbNullString 
        Body = vbNullString 
        Open BodyFileName For Input Access Read As #FNum 
        Do Until EOF(FNum) 
         Line Input #FNum, S 
         Body = Body & vbNewLine & S 
        Loop 
        Close #FNum 
        .TextBody = Body 
       Else 
        ' BodyFileName not found. 
        SendEMail = False 
        Exit Function 
       End If 
      End If ' MailBody and BodyFileName are both vbNullString. 
     End If 

     If IsArray(Attachments) = True Then 
      ' attach all the files in the array. 
      For N = LBound(Attachments) To UBound(Attachments) 
       ' ensure the attachment file exists and attach it. 
       If Attachments(N) <> vbNullString Then 
        If Dir(Attachments(N), vbNormal) <> vbNullString Then 
         .AddAttachment Attachments(N) 
        End If 
       End If 
      Next N 
     Else 
      ' ensure the file exists and if so, attach it to the message. 
      If Attachments <> vbNullString Then 
       If Dir(CStr(Attachments), vbNormal) <> vbNullString Then 
        .AddAttachment Attachments 
       End If 
      End If 
     End If 
     With .Configuration.Fields 
      ' set up the SMTP configuration 
      .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_Server 
      .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
      .Update 
     End With 

     On Error Resume Next 
     Err.Clear 
     ' Send the message 
     .Send 
     If Err.Number = 0 Then 
      SendEMail = True 
     Else 
      SendEMail = False 
      Exit Function 
     End If 
    End With 
Next NRecip 
SendEMail = True 
End Function 
If you want to attach the workbook that contains the code, you need to make the file read-only when you send it and then change access back to read-write. For example, 

ThisWorkbook.Save 
ThisWorkbook.ChangeFileAccess xlReadOnly 
B = SendEmail(_ 
    ... parameters ... 
    Attachments:=ThisWorkbook.FullName) 
ThisWorkbook.ChangeFileAccess xlReadWrite 
+0

도와 주셔서 감사합니다! –

관련 문제