试试下面的代码:
Sub test()
Dim Path As String
Dim fileName As String
Dim wkb As Workbook
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
Dim FileChosen As Integer
FileChosen = fd.Show
fd.Title = "Summary Data"
fd.InitialView = msoFileDialogViewSmallIcons
fd.Filters.Clear
fd.Filters.Add "Excel macros", "*.xls*"
fd.FilterIndex = 1
If FileChosen <> -1 Then
MsgBox "You chose cancel"
Path = vbNullString
Else
Path = fd.SelectedItems(1)
End If
If Path <> vbNullString Then
fileName = GetFileName(Path)
If IsWorkBookOpen(Path) Then
Set wkb = Workbooks(fileName)
Else
Set wkb = Workbooks.Open(fileName)
End If
If Not wkb Is Nothing Then
With wkb.Sheets("sheet1")
Set r = .Range(.Cells(1, 1), .Cells(.Rows.Count, "A"))
.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Sum(r)
End With
End If
End If
End Sub
Function GetFileName(fullName As String, Optional pathSeparator As String = "\") As String
Dim i As Integer
Dim iFNLenght As Integer
iFNLenght = Len(fullName)
For i = iFNLenght To 1 Step -1
If Mid(fullName, i, 1) = pathSeparator Then Exit For
Next
GetFileName = Right(fullName, iFNLenght - i)
End Function
Function IsWorkBookOpen(fileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open fileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function