【求助】当前活动文档自动保存并邮件发送特定邮箱代码

Private Sub Command1_Click()
Dim 收件人 As String, 主旨 As String, 內容 As String, 附件 As String
    收件人 = Text1.Text
    主旨 = Text2.Text
    內容 = Text3.Text
    附件 = Text4.Text
    Call 寄信(收件人, 主旨, 內容, 附件)
End Sub

Sub 寄信(收件人 As String, 主旨 As String, Optional 內容 As String, Optional 附件 As String)
    Dim ObjOL As Object
    Dim itmNewMail As Outlook.MailItem '需引用Microsoft Outlook [版本號] Object Library
    Dim mailaddress As String
    Set ObjOL = CreateObject("Outlook.Application") '創建Outlook物件
    Set itmNewMail = ObjOL.CreateItem(olMailItem) '建立信件物件
   
    With itmNewMail '新信參數
            .To = 收件人  '收件人
            .Subject = 主旨    '主旨
            .Body = 內容   '內容
           ' .CC=CC '副本
           ' .BCC = '秘件副本
            .Attachments.Add 附件   '附件
           ' .Importance = 2 '信件重要等級
            .Display  '開啟Outlook發送窗口
            '.send '發送
    End With
    Set ObjOL = Nothing '釋放
    Set itmNewMail = Nothing '釋放
End Sub

'開啟舊檔對話框
'專案>設定使用元件>Microsoft CommonDialog
'\Windows\system32\comdlg32.ocx
Private Sub Text4_GotFocus() '點擊時執行
    On Error Resume Next ' 略過錯誤
    CommonDialog1.Flags = cdlOFNHideReadOnly '單選 cdlOFNAllowMultiselect '改為復選
    '限制檔案類型
    CommonDialog1.Filter = "All Files (*.*)|*.*|Text Files(*.txt)|*.txt|Batch Files (*.bat)|*.bat"
    CommonDialog1.FilterIndex = 2   ' 預設第2 "|" 項目
    CommonDialog1.ShowOpen ' 顯示「開啟舊檔」對話方塊
    Text4.Text = CommonDialog1.FileName ' 顯示所選取檔案的名稱
End Sub
Private Sub Text1_GotFocus() '點擊時執行
    Text1.SelStart = 0 '選取內容 起始位置
    Text1.SelLength = Len(Text1.Text) '選取字數
End Sub
Private Sub Text2_GotFocus() '點擊時執行
    Text2.SelStart = 0 '選取內容 起始位置
    Text2.SelLength = Len(Text2.Text) '選取字數
End Sub
Private Sub Text3_GotFocus() '點擊時執行
    Text3.SelStart = 0 '選取內容 起始位置
    Text3.SelLength = Len(Text3.Text) '選取字數
End Sub