ExcelテーブルをHTMLにエクスポート

Question

Excelシートからデータを取得し、HTMLに変換して電子メールで送信するコードを実行しています。以下は、私が使用する方法である：

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

は、今私は、私は同じ形式（ボーダー、フォントなど）をHTMLにペーストをコピーしたいの完全なテーブルを持っている

誰かが助けてくださいどのようにそれを行うには？

Answer 1

回答はメールクライアントによって多少異なります。 OutlookはVBAと緊密に統合されています。一般的なメールクライアントを使用している場合は、引き続きタスクを実行できるはずですが、問題が発生する可能性があります。

ExcelからコピーしてOutlookにHTMLとして貼り付ける場合は、既に回答済みです：Copying values from excel to body of outlook email vb.net。

一般的なメールを使用して送信したい場合は、下記の私の答えをご覧ください。私はこれがHTMLでうまくいくと信じています。 （あなたのメールクライアントが渡されたHTMLに満足していない場合は、これをテキストファイルとして保存するように変換することができます）テキストファイルの場合、開発者のリボンから独自のマクロを記録できます。テキストファイルとして保存してください）。

以下に3つのサブ/機能があります。私は自分のコードであるHTMLExportをテストしました。 SendEMailはチップピアソンのサイトのものであり、うまく動作するはずです。 http://www.cpearson.com/Excel/EMail.aspx：私は単にあなたがチップピアソンからExcelから電子メールを送信するためのコードを見つけることができ旧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ライブラリ用のMicrosoft CDOへの参照が必要です。このファイルの一般的なファイルの場所はC：\ Windows \ system32 \ cdosys.dllです。このコンポーネントのGUIDは、主要= 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, chip@cpearson.com 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