Excel VBA表中添加打开文件夹按钮

Private Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub CommandButton1_Click()
    Dim Dia1 As Object, Strr As String, PPath As String
    Set Dia1 = Application.FileDialog(msoFileDialogFilePicker)
    With Dia1
        .AllowMultiSelect = False '限制只能同时选择一个文件
        .Filters.Clear
        .Filters.Add "所有文件", "*.txt", 1 '限制显示的文件类型
        .Show
        For Each vrtSelectedItem In .SelectedItems
            PPath = vrtSelectedItem
        Next
    End With
    Open PPath For Input As #1
        Do While Not EOF(1)
            Line Input #1, Strr
            If Sheet1.Cells(1, 1) <> "" Then
                Sheet1.Cells(1, 1) = Sheet1.Cells(1, 1) & Chr(10) & Strr
            Else
                Sheet1.Cells(1, 1) = Sheet1.Cells(1, 1) & Strr
            End If
        Loop
    Close #1
End Sub