VBA选择文件
Sub SelectFile()
Dim FileName As Variant
'打开文件对话框返回的文件名,是一个全路径文件名,其值也可能是False,因此类型为Variant
Dim sFileName As String '从FileName中提取的文件名
Dim sPathName As String '从FileName中提取的路径名
Dim aFile As Variant '数组,提取文件名sFileName时使用
Dim ws As Worksheet '存储文件路径名和文件名的工作表
Set ws = Worksheets("Sheet1") '设置工作表
FileName = Application.GetOpenFilename("Excel 文件 (*.xls),*.xls")
'调用Windows打开文件对话框
If FileName <> False Then '如果未按“取消”键
aFile = Split(FileName, "\") '在全路径中,以“\”为分隔符,分成数据
sPathName = aFile(0) '取盘符
For i = 1 To UBound(aFile) - 1 '循环合成路径名
sPathName = sPathName & "\" & aFile(i)
Next
sFileName = aFile(UBound(aFile)) '数组的最后一个元素为文件名
ws.Cells(1, 2).Value = sPathName '保存路径名
ws.Cells(2, 2).Value = sFileName '保存文件名
End If
End Sub
选择打开文件后并没有真实的把它打开,然后高容错性地打开文件
Function OpenExcelFile(sPath As String, ByVal sFileName As String, bDisplay As Boolean, sPwd As String) As Integer
'打开Excel文件
'Ver 1.05
'完成时间:2007.12.01
'设计:美猴王软件工作室 www.okexcel.com.cn
'参数说明:
'sPath:文件绝对路径;sFileName:Excel文件名;bDisplay:True显示错误信息;sPwd:文件打开密码
'返回值:-1:同名文件已经打开;-2:文件不存在或密码错误;0:成功打开;1:文件已经被打开
Dim bOpen As Boolean
Dim sFullName As String
On Error Resume Next
If InStr(LCase(sFileName), ".xls") = 0 Then sFileName = sFileName & ".xls"
sFullName = Workbooks(sFileName).FullName
'检查是否已经打开同名的Excel文件
'如果有sFullName不为空
On Error GoTo 0
bOpen = False
If sFullName <> "" Then
If LCase(sFullName) = LCase(sPath & "\" & sFileName) Then
bOpen = True
'判断已经打开的同名文件是否本次需要打开的文件
OpenExcelFile = 1
'文件已经被打开
Else
If bDisplay Then
MsgBox "请首先关闭“" & sFileName & "”文件!" & Chr(13) & "不能同时打开同名文件,这是Excel的规定!", vbOKOnly + vbExclamation, "文件的打开错误"
End If
bOpen = True
OpenExcelFile = -1
'不能同时打开同名文件,这是Excel的规定
End If
End If
If Not bOpen Then
On Error GoTo errOpen
Workbooks.Open Filename:=sPath & "\" & sFileName, Password:=sPwd
On Error GoTo 0
OpenExcelFile = 0
'成功打开文件
End If
Exit Function
errOpen:
If bDisplay Then MsgBox Err.Description, vbOKOnly + vbExclamation, "文件的打开错误"
OpenExcelFile = -2
'文件不存在或密码错误
On Error GoTo 0
End Function