Application.Run "НадстройкаМоя.xlam!Module1.myButton", Nothing

Sub WordTableToExcel()
'ZVI:2021-01-19 https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&TID=136468#message1109953

  Dim a, b()
  Dim r As Long, c As Long, rs As Long, cs As Long, i As Long
  Dim t As Single, t1 As Single
  
  t = Timer: t1 = t
  On Error GoTo exit_
  Debug.Print "Read",
  With GetObject(, "Word.Application").ActiveDocument.Tables(1)
    rs = .Rows.Count
    cs = .Columns.Count
    a = Split(.Range.Text, Chr(13) & Chr(7))
    .Parent.Close False
  End With
  Debug.Print Round(Timer - t, 3) & " s": t = Timer
  
  Debug.Print "Rebuild",
  ReDim b(0 To rs, 0 To cs - 1)
  For r = 0 To rs - 1
    For c = 0 To cs
      If c < cs Then b(r, c) = a(i)
      a(i) = Empty
      i = i + 1
    Next
  Next
  Debug.Print Round(Timer - t, 3) & " s": t = Timer
  
  Debug.Print "Write",
  Range("A1").Resize(rs, cs).Value = b()
  Debug.Print Round(Timer - t, 3) & " s"
  Debug.Print "Total", Round(Timer - t1, 3) & " s"
  
exit_:
  If Err Then MsgBox Err.Description, vbExclamation, "Word document not found!"
  
End Sub

'Требуется VBE-Tools-References-Microsoft Scripting Runtime
Sub Test1()

  Dim i As Long
  Dim a(0 To 2) As New Dictionary

  For i = 0 To UBound(a)
    Set a(i) = Nothing
    Debug.Print i, a(i) Is Nothing
  Next

End Sub

' Для сравнения
Sub Test2()

  Dim i As Long
  Dim a(0 To 2) As Dictionary

  For i = 0 To UBound(a)
    Set a(i) = New Dictionary
  Next

  For i = 0 To UBound(a)
    Set a(i) = Nothing
    Debug.Print i, a(i) Is Nothing
  Next

End Sub

  Dim dic As Dictionary
  Set dic = New Dictionary

  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")

Type MyType1
  Int1 As Integer
  Int2 As Integer
  Lng As Long
End Type
 
Sub Test1()
  Dim x As MyType1
  Debug.Print "Integer", VarPtr(x.Lng) - VarPtr(x.Int2)
End Sub

Sub Test()
'Требуется VBE-Tools-References-Microsoft Scripting Runtime 
  
  Dim dic As New Dictionary
  
  dic.Add "Key", "Item"

  MsgBox dic.Count()

  Set dic = Nothing
  
  If dic Is Nothing Then
    MsgBox "dic is nothing"
  Else
    MsgBox "dic is not nothing"
  End If
  
  MsgBox dic.Count()
  
End Sub

Type MyType1
  Int As Integer
  Lng As Long
End Type

Type MyType2
  Bt As Byte
  Lng As Long
End Type

Sub Test1()
  Dim x As MyType1, y As MyType2
  Debug.Print "Integer", VarPtr(x.Lng) - VarPtr(x.Int)
  Debug.Print "Byte", VarPtr(y.Lng) - VarPtr(y.Bt)
End Sub

Sub TestJson3()
  Dim s As String, i As Long, nMax As Long, t As Double
  Dim json As Object ' As Collection
  ' Генерация строки json: массив с 2 объектами
  nMax = 100000
  ReDim arr(1 To nMax)
  For i = 1 To nMax
    arr(i) = "{""Key1"":1, ""Key2"":""Value2""}"
  Next i
  s = "[" & Join(arr, "," & vbLf) & "]"
  Erase arr
  Stop ' для замера памяти
  t = Timer
  For i = 1 To 10
    Set json = ParseJson(s)
    If TypeName(json) = "Collection" Then Set json = New Collection
    Set json = Nothing
  Next i
  Debug.Print "Time="; Format(Timer - t, "0.00") ', nMax
  Stop ' для замера памяти
End Sub

Sub Test_Json()
  Const N = 10000
  Dim i As Long, s As String
  Dim oResponse As Object ' Dictionary
  s = "{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}"
  For i = 1 To N
    Set oResponse = JsonConverter.ParseJson(s)
    'oResponse.RemoveAll: DoEvents
    If i = N Then Stop
  Next
End Sub

Function SetClipBoardText(ByVal Text As Variant) As Boolean
  SetClipBoardText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text)
End Function

Function GetClipBoardText() As String
  On Error Resume Next
  GetClipBoardText = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("Text")
End Function

Function ClearClipBoardText() As Boolean
  ClearClipBoardText = CreateObject("htmlfile").ParentWindow.ClipboardData.СlearData("Text")
End Function

let
    Source = Excel.CurrentWorkbook(){[Name="Таблица4"]}[Content],
    Result = Table.TransformColumns(Source, {"Столбец3", each Number.ToText(_, " 000-000-000000"), Text.Type})
in
    Result

Set .SendUsingAccount = objOutlookApp.Session.Accounts.Item("testmail@mail.ru")