Body Message

[josros60]

I have this code and worked fine with all your help,


the problem having now that i have table that i want it to be displayed in the body message and
and have this line of code but when executed got run-time error 13, please help:
but this is the line giving the problem:

Email_body = "[FONT=calibri]" & "Hi" & " " & ActiveSheet.Range("C2") & "," & "
" & "
" & ActiveSheet.Range("A15") & "," & "
" & "
" & "
" & [COLOR=#ff0000][B]ActiveSheet.Range("A6:C9")[/B][/COLOR]

Sub SEND_CC()
Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String, Email_body As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim Signature As String
CurrentMonth = ""


' *****************************************************
' *****     You Can Change These Variables    *********


    EmailSubject = "TNW a/c " & " " & ActiveSheet.Range("A7") & ", " & ActiveSheet.Range("A8") & " " & "Credit Card charges authorization for the October Invoices," & Format(Range("B9").Value, "$#,##0.00;($#,##0.00)")
  'Change this to change the subject of the email. The current month is added to end of subj line
    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE
    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
    DisplayEmail = True 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = ActiveSheet.Range("E2")   'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = "accounts.receivable@navigata.ca"
    Email_BCC = ""
    Email_body = "[/FONT]
[FONT=calibri]" & "Hi" & " " & ActiveSheet.Range("C2") & "," & "
" & "
" & ActiveSheet.Range("A15") & "," & "
" & "
" & "
" & [B][COLOR=#ff0000]ActiveSheet.Range("A6:C9")[/COLOR][/B]
' ******************************************************
 'Change only Mysig.htm to the name of your signature
    SigString = Environ("appdata") & _
                "\Microsoft\Signatures\JROSSI.htm"


    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If


    On Error Resume Next
    
    'Prompt for file destination
    With Application.FileDialog(msoFileDialogFolderPicker)
        
        If .Show = True Then
        
            DestFolder = "C:\Documents and Settings\rossj1\Desktop\Excel Files\STATEMENT\EXCEL_PDF" '.SelectedItems(1)
            
        Else
        
            MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify  Destination Folder"
                
            Exit Sub
            
        End If
        
    End With


    'Current month/year stored in H6 (this is a merged cell)
    CurrentMonth = Mid(ActiveSheet.Range("H6").Value, InStr(1, ActiveSheet.Range("H6").Value, " ") + 1)
    
    'Create new PDF file name including path and file extension
    'PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Range("FILENAMETO") _
               & "_" & CurrentMonth & ".pdf"


    'If the PDF already exists
   ' If Len(Dir(PDFFile)) > 0 Then
    
       ' If AlwaysOverwritePDF = False Then
        
         '   OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwriteit?", vbYesNo + vbQuestion, "File Exists")
        
           ' On Error Resume Next
            'If you want to overwrite the file then delete the current one
           ' If OverwritePDF = vbYes Then
    
                'Kill PDFFile
        
            'Else
    
              '  MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
                
              ' Exit Sub
        
            'End If


        'Else
        
           ' On Error Resume Next
          '  Kill PDFFile
            
        'End If


 If Err.Number <> 0 Then
        
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
                
            Exit Sub
        
        End If
            
    'End If
   


    'Create the PDF
    'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True 'OpenPDFAfterCreating


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        
    'Display email and specify To, Subject, etc
    With OutlookMail
        
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        '.Body = Email_body
        .HTMLBody = Email_body & "
" & .HTMLBody  '
        .Attachments.Add PDFFile
                
        If DisplayEmail = False Then
            
            .send
            
        End If
        
    End With
End Sub

thank you[/FONT]

 

[Kenneth Hobson]

I can't tell what string you were trying to build. Likely, you have some html that was translated by the forum. e.g. (BR) where <> replaces the ()'s.

In this replace ()'s with []'s due to forum translation as it uses html of a sort.

Sub Test()
  Email_body$
  Email_body = "(BR)Hi" & " " & _
    Range("C2").Value & ", (BR)" _
    & Range("A15").Value & ", " _
    & Range("A6:C9").Value
  Debug.Print Email_body
End Sub

For the "table" part, most would use Ron de Bruin's RangeToHtml() when using htmlBody. e.g.

'http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
    .HTMLBody = RangetoHTML([B6:R136]) & sig