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]>", _
                          "")

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 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

Format(Date, "ww")

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Count > 1 Then Exit Sub
        If Intersect(.Cells, Columns(2)) Is Nothing Then Exit Sub
        If Not IsDate(Cells(.Row, 1)) Then Cells(.Row, 1).Value = Date
        If IsEmpty(.Cells) Then Cells(.Row, 1).ClearContents
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Count > 1 Then Exit Sub
        If Intersect(.Cells, Range("B:P")) Is Nothing Then Exit Sub
        If Not IsDate(Cells(.Row, 1)) Then Cells(.Row, 1).Value = Date
    End With
End Sub

Sub Filter()
    Dim filterRange As Range, ColNumber
    Set filterRange = Range("A1").CurrentRegion
    ColNumber = InputBox("COLUMN Number", , Selection.Column)
    If Len(ColNumber) Then filterRange.AutoFilter ColNumber, "Test", xlFilterValues
End Sub

Sub FilterMultipleCriteria()
    Dim filterRange As Range,
    Set filterRange = Range("A1")
    Dim ColNumber As Integer
    ColNumber = Val(InputBox("COLUMN Number"))
    On Error GoTo CurrentColumn
    filterRange.AutoFilter Field:=ColNumber, Criteria1:="Test", Operator:=xlFilterValues
       Exit Sub
CurrentColumn:
        filterRange.AutoFilter Field:=Selection.Column, Criteria1:=Test, Operator:=xlFilterValues
End Sub

 ColNumber = Val(InputBox("COLUMN Number"))
    filterRange.AutoFilter Field:=ColNumber, Criteria1:=Test, Operator:=xlFilterValues

filterRange.AutoFilter Field:=Selection.Column, Criteria1:=Test, Operator:=xlFilterValues

 On Error GoTo CurrentColumn <---------
    filterRange.AutoFilter Field:=ColNumber, Criteria1:=Test, Operator:=xlFilterValues
       Exit Sub <---------
CurrentColumn: <---------
        filterRange.AutoFilter Field:=Selection.Column, Criteria1:=Test, Operator:=xlFilterValues
End Sub

CurrentColumn: 
        filterRange.AutoFilter Field:=Selection.Column, Criteria1:=Test, Operator:=xlFilterValues

 Dim filterValues() As Variant, cl As Range, i As Integer, rng As Range
    Set rng = Range("E2", Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible) ' - Âèäèìûå çàïîëíåííûå ÿ÷åéêè ñòîëáöà E2 äëÿ ôèëüòðàöèè
    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:=5, Criteria1:=filterValues, Operator:=xlFilterValues

Sub FilterMultipleCriteria()
Dim filterRange As Range, filterValues() As Variant, cl As Range, i As Integer
    Set filterRange = Range("A1")
        If Selection.Count > 1 Then
    ReDim filterValues(Selection.SpecialCells(xlCellTypeVisible).Count - 1)
        Else
    ReDim filterValues(Selection.Cells.Count - 1)
    i = 0
    End If
    For Each cl In Selection
    ReDim Preserve filterValues(i)
        filterValues(i) = cl.Text
        i = i + 1
    Next cl

Dim RowNumber As Integer
RowNumber = Val(InputBox("Row Number"))
    filterRange.AutoFilter Field:=RowNumber, Criteria1:=filterValues, Operator:=xlFilterValues
End Sub

Sub Replace_by_VAL()   '  в выбранном диапазоне в не скрытых ячейках заменить формулы на значения
    On Error Resume Next
    With ActiveWindow.RangeSelection
    If .Count = 1 Then
        .Cells(1).Select
    Else
        .Cells.SpecialCells(xlCellTypeFormulas).SpecialCells(xlCellTypeVisible).Select
    End If
    End With
    Selection.Value = Selection.Value
End Sub

Sub Formulas_To_Values_Selection()
'преобразование формул в значения в выделенном диапазоне(ах)
    Dim smallrng As Range
    For Each smallrng In Selection.Areas
        smallrng.Value = smallrng.Value
    Next smallrng
End Sub

wbNameOld = ThisWorkbook.Name
wbNameNew = Replace(wbNameOld, "Экспорт заказов, "_")
If wbNameOld <> wbNameNew Then
     Application.Run "GateInfoGroupup"
Else
    'Do Nothing
End If

Application.OnKey "^\", "MacroNAME"