Excel VBA选择文件、高容错性地打开文件
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 IfEnd 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 FunctionerrOpen: If bDisplay Then MsgBox Err.Description, vbOKOnly + vbExclamation, "文件的打开错误" OpenExcelFile = -2 '文件不存在或密码错误 On Error GoTo 0End Function?
?
?
?
?
?
?
?
?
?
?
?
?
?
?
?
?