1.【編集】【リンクの設定】で、現在参照しているシートを選択し、【リンク元の変更】
　2.　出てきたファイル選択画面から、現在のファイルを探して選択し、【ＯＫ】【閉じる】

Sub test2()
　Dim a() As Integer
　ReDim a(2)
　　'この間使える変数は、a(0)、a(1)、a(2)
　ReDim a(1)
　　'この間使える変数は、a(0)、a(1)
End Sub

Private Declare Function ReadMail Lib "bsmtp" _
(szFilename As String, szPara As String, szDir As String) As Variant
Sub メールファイル書き出し()
　'************************************************************
　'***** 指定ファルダ内のファイル名をA列に記入
　'************************************************************
　Dim N As String
　Dim PathName As String
　'メールのemlファイルが保存されるフォルダのフルパス
　PathName = "C:\My Documents\保存メール\"　　’←環境に合わせて変更してください
　N = Dir(PathName & "*.eml")
　Do Until N = ""
　　Cells(Cells(Rows.Count, "A").End(xlUp).Row + 1, 1) = N
　　N = Dir()
　Loop
　'************************************************************
　'***** メール内容を書き出し　(A列にヘッダー、B列に本文を書き出します)
　'************************************************************
　Dim szFilename As String, szPara As String, szDir As String
　Dim retv As Variant, v As Variant
　Dim i As Long, j As Long, k As Long
　For k = 2 To Cells(Rows.Count, "A").End(xlUp).Row
　　szFilename = PathName & Cells(k, 1)
　　szDir = Left(PathName, Len(PathName) - 1) ' 添付ファイルが保存されるディレクトリ
　　szPara = "subject:from:to:date:" ' ヘッダーの指定
　　' nofile: とすると添付ファイルを保存しません。
　　Cells(Cells(Rows.Count, "A").End(xlUp).Row + 1, 1) = " "
　　Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2) = " "
　　Rows(Cells(Rows.Count, "A").End(xlUp).Row).Interior.ColorIndex = 6
　　retv = ReadMail(szFilename, szPara, szDir)
　　If IsArray(retv) Then
　　　For Each v In retv
　　　　If Left(v, 4) <> "Body" Then
　　　　　Cells(Cells(Application.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = v
　　　　Else
　　　　　i = 2
　　　　　Do
　　　　　　If Mid(v, i, 1) = Chr(10) Then
　　　　　　　If Left(v, i - 2) <> "" Then
　　　　　　　　Cells(Cells(Application.Rows.Count, 2).End(xlUp).Row + 1, 2).Value = Left(v, i - 2)
　　　　　　　Else
　　　　　　　　Cells(Cells(Application.Rows.Count, 2).End(xlUp).Row + 1, 2).Value = " "
　　　　　　　End If
　　　　　　　v = Right(v, Len(v) - i)
　　　　　　　i = 2
　　　　　　Else
　　　　　　　i = i + 1
　　　　　　End If
　　　　　　If Right(v, Len(v) - i) = "" Then Exit Do
　　　　　Loop
　　　　End If
　　　Next
　　　Cells(Cells(Application.Rows.Count, 2).End(xlUp).Row, 1).Value = " "
　　Else
　　　Cells(Cells(Application.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = retv
　　End If
　Next
End Sub
　　このコードの使い方は、マクロの使い方(１)標準モジュールにあります。