Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"

Sub AttachTenderFiles()
    Dim objOutApp As Object, objMail As Object
    Dim myItem As Outlook.MailItem
    Dim myAttachments As Outlook.Attachments
    
    Set myItem = Application.ActiveInspector.CurrentItem
    Set myAttachments = myItem.Attachments
    With Excel.Application

        Dim oFD As FileDialog
        Dim x, lf As Long
        Set App = Excel.Application
        Set oFD = App.FileDialog(msoFileDialogFilePicker)
        With oFD 
            .AllowMultiSelect = True
            .Title = "Test" 
            .Filters.Clear 
            '.FilterIndex = 2
            .InitialFileName = "%APPDATA%\Microsoft\Windows\Recent\" 
            .InitialView = msoFileDialogViewList
            .oFD.Show
        End With
    End With
     
    Dim sInputFile As Variant
    For Each sInputFile In oFD.SelectedItems
    myAttachments.Add sInputFile, 1
    Next sInputFile
    myAttachments.Add ("P:\Test.xlsx")

End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

*Код, выбирающий письмо в папке*

End Sub

<![if supportMisalignedColumns]> 
  <tr height=0 style='display:none'>
  <td width=76 style='width:57pt'></td>
  <td width=216 style='width:162pt'></td>
  <td width=113 style='width:85pt'></td>
  <td width=120 style='width:90pt'></td>
  <td width=56 style='width:42pt'></td>
 </tr>
 <![endif]>

RangetoHTML = Replace(RangetoHTML, "<![if supportMisalignedColumns]>*<![endif]>", _
                          "")

<tr height=0 style='display:none'>  
<td width=76 style='width:57pt'></td>

<tr height=0 style='display:none'>   
<td width=20 style='width:30pt'></td>

Set rng = ActiveSheet.UsedRange.SpecialCells(12)

<![if supportMisalignedColumns]>
 <tr height=0 style='display:none'>
  <td width=76 style='width:57pt'></td>
  <td width=216 style='width:162pt'></td>
  <td width=113 style='width:85pt'></td>
  <td width=120 style='width:90pt'></td>
  <td width=56 style='width:42pt'></td>
 </tr>
 <![endif]>

RangetoHTML = Replace(RangetoHTML, "<![if supportMisalignedColumns]>*<![endif]>", _
                          "")

Sub Main_macro()
UserForm3.Show
End Sub

Private Sub CommandButton1_Click()
Dim myfilepath As String
myfilepath = Application.GetOpenFilename
TextBox1.Text = myfilepath
End Sub

Private Sub CommandButton2_Click()
mypath = TextBox1.Text
Call send_Test(mypath)
End Sub

Sub send_Test(ByVal mypath)
Dim objOutApp As Object, objMail As Object, wb As Workbook, mass()
Set objOutApp = CreateObject("Outlook.Application")
Set objMail = objOutApp.CreateItem(0)


    With objMail
    .display
   .attachments.Add (mypath)

  Set objMail = Nothing
End With
Set objOutApp = Nothing
End Sub

Sub AAA()
  Dim cl As Range, rng As Range, rg As Range, f$
  Set rng = Selection.SpecialCells(xlCellTypeVisible)
  Set rg = Cells(2, 3).Resize(ActiveSheet.UsedRange.Rows.Count - 1, 1)
    For Each cl In rg
    If rng.Find(cl, , xlValues, xlWhole) Is Nothing Then f = f & Chr(9) & cl.Text
  Next cl
  Range("A1").AutoFilter Field:=3, Criteria1:=Split(Right(f, Len(f) - 1), Chr(9)), Operator:=xlFilterValues
End Sub

Set rg = Cells(2, 3).Resize(ActiveSheet.UsedRange.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)

Sub AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA()
    Dim cl As Range, rng As Range, filterValues() As Variant
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    ReDim filterValues(1 To rng.Count)
    i = 0
    For Each cl In rng
        i = i + 1
        filterValues(i) = cl.Text
    Next cl
    Range("A1").AutoFilter Field:=3, Criteria1:=filterValues, Operator:=xlFilterValues
End Sub

Set range1 = Range("D3", Range("D65000").End(xlUp).Offset(-1)).SpecialCells(xlCellTypeVisible)
  For Each cell In range1
       cell.Formula = "=SUM(" & [Previous].cell.offset(1,0).Address(False, False) & ":" & cell.Offset(-1, 0).Address(False, False) & ")" 
  Next cell