Exporting several charts as images creates several empty files

[monsefoster]

Hello Guys.
I'm trying to loop through all the charts in a sheet, then save it to PNG and then attach it in a email.
Technically, it works. However, most of the time the charts generate an empty file after generating a working one.
And sometimes, it just generates two charts without any order (In this case chart 6,7)

​

I wanted to know if I might be working with a memory problem or something.

here's the code.

Sub SendGraphsAndTableInEmail()
    Dim sheetNumber, Size, i As Integer
    Dim chartNames(), FNames() As String
    Dim objChrt As ChartObject
    Dim myChart As Chart


    'Activate Charts Sheet
    Sheets("GRAFICAS").Activate
    'Calculate Number of Charts in Sheet
    Dim chartNumber
    chartNumber = ActiveSheet.ChartObjects.Count
    'Redimension Arrays to fit all Chart Export Names
    ReDim chartNames(chartNumber)
    ReDim FNames(chartNumber)
    'Loops through all the charts in the GRAFICAS sheet
    For i = 1 To chartNumber
        'Select chart with index i
        Set objChrt = ActiveSheet.ChartObjects(i)
        Set myChart = objChrt.Chart
        'Generate a name for the chart
        chartNames(i) = "myChart" & i & ".png"


        On Error Resume Next
        Kill ThisWorkbook.Path & "\" & chartNames(i)
        On Error GoTo 0
        'Export Chart
        myChart.Export FileName:=Environ$("TEMP") & "\" & chartNames(i), Filtername:="PNG"
        'Save path to exported chart
        FNames(i) = Environ$("TEMP") & "\" & chartNames(i)
    Next i
    'Export Table
   ' Dim Used
    Sheets("CUADRO").Activate
    Used = ActiveSheet.UsedRange.Rows.Count
    Dim rng As Range
    Set rng = ActiveSheet.Range("A1:E" & Used).SpecialCells(xlCellTypeVisible)
    
   ' MsgBox Used
    'Declare the Object variables for Outlook.
    Dim objOutlook As Object
    'Verify Outlook is open.
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    'If Outlook is not open, end the Sub.
    If objOutlook Is Nothing Then
        Err.Clear
         MsgBox _
        "Cannot continue, Outlook is not open.", , _
        "Please open Outlook and try again."
        Exit Sub
    'Outlook is determined to be open, so OK to proceed.
    Else
        'Establish an Object variable for a mailitem.
        Dim objMailItem As Object
        Set objMailItem = objOutlook.CreateItem(0)
        'Build the mailitem.
        Dim NewBody As String
            On Error Resume Next
            With objMailItem
                .To = "dummy@test.com"
                .Subject = "email"
                .Importance = 1 'Sets it as Normal importance (Low = 0 and High = 2)
                'Change the Display command to Send without reviewing the email.
               ' .Display
            End With
           For i = 1 To chartNumber
               'objMailItem.Attachments.Add FNames(i)
                Dim attach
                Set attach = objMailItem.Attachments.Add(FNames(i))
                'Put together the HTML to embed
                Dim cid
                cid = "myChart" & i & ".png"
                'Attach each image with an unique ID
                NewBody = NewBody + HTMLcode & "[CENTER]" & "[IMG]http://www.mrexcel.com/forum/"[/IMG]" & "[/CENTER]


"
                Call attach.PropertyAccessor.SetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F", cid)
            Next
           'Add the table at the end as an HTML table
            NewBody = NewBody & "

" & RangetoHTML(rng)
               'Set the HTML body
                objMailItem.HTMLBody = NewBody
                'Display email before sending
                objMailItem.Display
    'Close the If block.
    End If
        Kill FNames
End Sub


Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         FileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=center x:publishsource=")


    'Close TempWB
    TempWB.Close savechanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

 

[monsefoster]

Found the answer here http://www.mrexcel.com/forum/excel-...-applications-sometimes-gives-empty-file.html