Public Function Together_Array(Dec_Mark, Value_Array) As String
    Dim q As Long
    Dim MAX As Long
    q = 1
    MAX = UBound(Value_Array)
    On Error Resume Next
    For q = 1 To MAX
        If Value_Array(q, 1) <> "0" Then
            Together_Array = Together_Array + CStr(Value_Array(q, 1)) + Dec_Mark
            End If
    Next q
    If Len(Together_Array) > 0 Then Together_Array = Left(Together_Array, Len(Together_Array) - 1)
End Function

Public Function Together_Array$(Dec_Mark$, Value_Array())
    Value_Array = Application.Transpose(Value_Array)
    Together_Array = Join(Value_Array, Dec_Mark)
End Function

Public Function Together_Array(Dec_Mark As String, ParamArray Value_Array() As Variant) As String
Dim s As String
s = Value_Array(1)
Together_Array = Join(Value_Array, Dec_Mark)
End Function

Public Function DO_with_DATE (DATE as long, Dates as variant, SUMs as variant)

cells(dates.row + q, dates.colunm).value

=DO_with_DATE (A1;[другой файл]лист1.А1:А100;[другой файл]лист1.Б1:Б100)

Sub SendMail_auto()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim TepmFilePath As String
    Dim q As Integer
   
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    On Error GoTo cleanup
    q = 1
Do While Worksheets("AUTODATA").Cells(q, 1).Value <> ""
    Cells(1, 2).Value = Worksheets("AUTODATA").Cells(q, 1).Value
    Cells(16, 5).Value = Worksheets("AUTODATA").Cells(q, 2).Value
    
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next

    With OutMail

            .To = Cells(1, 2).Value
            .Subject = Cells(2, 2).Value
            .HTMLBody = Cells(3, 2).Value
            .Send
            

    End With
    q = q + 1
Loop
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

<p class=MsoNormal style='margin-bottom:12.0pt'><br>
<!--[if gte vml 1]><v:shapetype id="_x0000_t75" coordsize="21600,21600" o:spt="75"
 o:preferrelative="t" path="m@4@5l@4@11@9@11@9@5xe" filled="f" stroked="f">
 <v:stroke joinstyle="miter"/>
 <v:formulas>
  <v:f eqn="if lineDrawn pixelLineWidth 0"/>
  <v:f eqn="sum @0 1 0"/>
  <v:f eqn="sum 0 0 @1"/>
  <v:f eqn="prod @2 1 2"/>
  <v:f eqn="prod @3 21600 pixelWidth"/>
  <v:f eqn="prod @3 21600 pixelHeight"/>
  <v:f eqn="sum @0 0 1"/>
  <v:f eqn="prod @6 1 2"/>
  <v:f eqn="prod @7 21600 pixelWidth"/>
  <v:f eqn="sum @8 21600 0"/>
  <v:f eqn="prod @7 21600 pixelHeight"/>
  <v:f eqn="sum @10 21600 0"/>
 </v:formulas>
 <v:path o:extrusionok="f" gradientshapeok="t" o:connecttype="rect"/>
 <o:lock v:ext="edit" aspectratio="t"/>
</v:shapetype><v:shape id="_x0000_i1025" type="#_x0000_t75" alt="" style='width:663pt;
 height:345.75pt'>
 <v:imagedata src="1111.files/image001.jpg" o:href="1.jpg"/>
</v:shape><![endif]--><![if !vml]><img border=0 src="1111.files/image001.jpg"
v:shapes="_x0000_i1025"><![endif]></p>

<br> <img src='1.jpg' width=width height=height><br><br>

Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim TepmFilePath As String
   
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   
    OutApp.Session.Logon
    On Error GoTo cleanup  
    Set OutMail = OutApp.CreateItem(0)   
    On Error Resume Next
    'çàïîëíÿåì ïîëÿ ñîîáùåíèÿ
    With OutMail
        .To = Cells(1, 2).Value
        .Subject = Cells(2, 2).Value
        TempFilePath = "D:\Mailing\"
        .Attachments.Add TempFilePath & Cells(5, 2).Value, olByValue, 0
        .Attachments.Add TempFilePath & Cells(6, 2).Value, olByValue, 0
        .Attachments.Add TempFilePath & Cells(7, 2).Value, olByValue, 0
        .Attachments.Add TempFilePath & Cells(8, 2).Value, olByValue, 0
        .HTMLBody = Cells(3, 2).Value
        Cells(45, 4).Value = Cells(3, 2).Value
        'Set .SendUsingAccount = .Session.Accounts.Item(Cells(1, 3).Value)
        
        .Send
        '.Display
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

.Attachments.Add TempFilePath & Cells(5, 2).Value, olByValue, 0

Function IMG(Folder As String, S As String) As String
'IMG = " <br> <img src='cid:" & Folder + S & "'" & " width=width height=height><br><br>"
'IMG = " <br> <img src=""cid:" & Folder + S & """" & " width=width height=height><br><br>"
'IMG = " <br> <img src=""" & Folder + S & """" & " width=width height=height><br><br>"
'IMG = " <br> <img src=""cid:" & Folder + S & """" & "><br><br>"
'IMG = " <br> <img src='cid:" & Folder + S & "'" & "><br><br>"
End Function

Sub DA_Graph_this_month()
Dim This_chart_S As Series

Set This_chart_S = ActiveSheet.ChartObjects(CST_MONTHLY_GRAPH).Chart.FullSeriesCollection(1)

If This_chart_S.IsFiltered = True Then
    This_chart_S.IsFiltered = False
    Else
    This_chart_S.IsFiltered = True
    End If

End Sub