示例03-26：判断工作簿是否存在 Sub testFileExists() MsgBox "如果文件不存在则用信息框说明,否则打开该文件." If Not FileExists("C:\文件夹\子文件夹\文件.xls") Then MsgBox "这个工作簿不存在!" Else Workbooks.Open "C:\文件夹\子文件夹\文件.xls" End If End Sub ‘- - - - - - - - - - - - - - - - - - - - - - - Function FileExists(FullFileName As String) As Boolean '如果工作簿存在,则返回True FileExists = Len(Dir(FullFileName)) > 0 End Function 示例说明：本示例使用自定义函数FileExists判断工作簿是否存在，若该工作簿已存在，则打开它。代码中，“C:\文件夹\子文件夹\文件.xls”代表工作簿所在的文件夹名、子文件夹名和工作簿文件名 示例03-27：判断工作簿是否已打开 [示例03-27-01] Sub testWorkbookOpen() MsgBox "如果工作簿未打开,则打开该工作簿." If Not WorkbookOpen("工作簿名.xls") Then Workbooks.Open "工作簿名.xls" End If End Sub ‘- - - - - - - - - - - - - - - - - - - - - - - Function WorkbookOpen(WorkBookName As String) As Boolean '如果该工作簿已打开则返回真 WorkbookOpen = False On Error GoTo WorkBookNotOpen If Len(Application.Workbooks(WorkBookName).Name) > 0 Then WorkbookOpen = True MsgBox "该工作簿已打开" Exit Function End If WorkBookNotOpen: End Function 示例说明：本示例中的函数WorkbookOpen用来判断工作簿是否打开。代码中，“工作簿名.xls”代表所要打开的工作簿名称。 [示例03-27-02] Sub testWookbookIFOpen() Dim wb As String Dim bwb As Boolean wb = "<要判断的工作簿名称>" bwb = WorkbookIsOpen(wb) If bwb = True Then MsgBox "工作簿" & wb & "已打开." Else MsgBox "工作簿" & wb & "未打开." End If End Sub ‘- - - - - - - - - - - - - - - - - - - - - - - Private Function WorkbookIsOpen(wbname) As Boolean Dim x As Workbook On Error Resume Next Set x = Workbooks(wbname) If Err = 0 Then WorkbookIsOpen = True Else WorkbookIsOpen = False End If End Function 示例03-28：备份工作簿 [示例03-28-01] 用与活动工作簿相同的名字但后缀名为.bak备份工作簿 Sub SaveWorkbookBackup() Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub Set awb = ActiveWorkbook If awb.Path = "" Then Application.Dialogs(xlDialogSaveAs).Show Else BackupFileName = awb.FullName i = 0 While InStr(i + 1, BackupFileName, ".") > 0 i = InStr(i + 1, BackupFileName, ".") Wend If i > 0 Then BackupFileName = Left(BackupFileName, i - 1) BackupFileName = BackupFileName & ".bak" OK = False On Error GoTo NotAbleToSave With awb Application.StatusBar = "正在保存工作簿..." .Save Application.StatusBar = "正在备份工作簿..." .SaveCopyAs BackupFileName OK = True End With End If NotAbleToSave: Set awb = Nothing Application.StatusBar = False If Not OK Then MsgBox "备份工作簿未保存!", vbExclamation, ThisWorkbook.Name End If End Sub 示例说明：在当前工作簿中运行本示例代码后，将以与工作簿相同的名称但后缀名为.bak备份工作簿，且该备份与当前工作簿在同一文件夹中。其中，使用了工作簿的FullName属性和SaveCopyAs方法。 [示例03-28-02] 保存当前工作簿的副本到其它位置备份工作簿 Sub SaveWorkbookBackupToFloppyD() Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub Set awb = ActiveWorkbook If awb.Path = "" Then Application.Dialogs(xlDialogSaveAs).Show Else BackupFileName = awb.Name OK = False On Error GoTo NotAbleToSave If Dir("D:\" & BackupFileName) <> "" Then Kill "D:\" & BackupFileName End If With awb Application.StatusBar = "正在保存工作簿..." .Save Application.StatusBar = "正在备份工作簿..." .SaveCopyAs "D:\" & BackupFileName OK = True End With End If NotAbleToSave: Set awb = Nothing Application.StatusBar = False If Not OK Then MsgBox "备份工作簿未保存!", vbExclamation, ThisWorkbook.Name End If End Sub 示例说明：本程序将把当前工作簿进行复制并以与当前工作簿相同的名称保存在D盘中。其中，使用了Kill方法来删除已存在的工作簿 示例03-29：从已关闭的工作簿中取值 [示例03-29-01] Sub testGetValuesFromClosedWorkbook() GetValuesFromAClosedWorkbook "C:", "Book1.xls", "Sheet1", "A1:G20" End Sub ‘- - - - - - - - - - - - - - - - - - - - - - - Sub GetValuesFromAClosedWorkbook(fPath As String, _ fName As String, sName, cellRange As String) With ActiveSheet.Range(cellRange) .FormulaArray = "='" & fPath & "\[" & fName & "]" _ & sName & "'!" & cellRange .Value = .Value End With End Sub 示例说明：本示例包含一个子过程GetValuesFromAClosedWorkbook，用来从已关闭的工作簿中获取数据，主过程testGetValuesFromClosedWorkbook用来传递参数。本示例表示从C盘根目录下的Book1.xls工作簿的工作表Sheet1中的A1:G20单元格区域内获取数据，并将其复制到当前工作表相应单元格区域中。 [示例03-29-02] Sub ReadDataFromAllWorkbooksInFolder() Dim FolderName As String, wbName As String, r As Long, cValue As Variant Dim wbList() As String, wbCount As Integer, i As Integer FolderName = "C:\文件夹名" '创建文件夹中工作簿列表 wbCount = 0 wbName = Dir(FolderName & "\" & "*.xls") While wbName <> "" wbCount = wbCount + 1 ReDim Preserve wbList(1 To wbCount) wbList(wbCount) = wbName wbName = Dir Wend If wbCount = 0 Then Exit Sub '从每个工作簿中获取数据 r = 0 Workbooks.Add For i = 1 To wbCount r = r + 1 cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1") Cells(r, 1).Formula = wbList(i) Cells(r, 2).Formula = cValue Next i End Sub ‘- - - - - - - - - - - - - - - - - - - - - - - Private Function GetInfoFromClosedFile(ByVal wbPath As String, _ wbName As String, wsName As String, cellRef As String) As Variant Dim arg As String GetInfoFromClosedFile = "" If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\" If Dir(wbPath & "\" & wbName) = "" Then Exit Function arg = "'" & wbPath & "[" & wbName & "]" & _ wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1) On Error Resume Next GetInfoFromClosedFile = ExecuteExcel4Macro(arg) End Function 示例说明：本示例将读取一个文件夹内所有工作簿中工作表Sheet1上单元格A1中的值到一个新工作簿中。代码中，“C:\文件夹名”代表工作簿所在的文件夹名。 [示例03-29-03] Sub GetDataFromClosedWorkbook() Dim wb As Workbook Application.ScreenUpdating = False '以只读方式打开工作簿 Set wb = Workbooks.Open("C:\文件夹名\文件.xls", True, True) With ThisWorkbook.Worksheets("工作表名") '从工作簿中读取数据 .Range("A10").Formula = wb.Worksheets("源工作表名").Range("A10").Formula .Range("A11").Formula = wb.Worksheets("源工作表名").Range("A20").Formula .Range("A12").Formula = wb.Worksheets("源工作表名").Range("A30").Formula .Range("A13").Formula = wb.Worksheets("源工作表名").Range("A40").Formula End With wb.Close False '关闭打开的源数据工作簿且不保存任何变化 Set wb = Nothing '释放内存 Application.ScreenUpdating = True End Sub 示例说明：在运行程序时，打开所要获取数据的工作簿，当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False，将看不出源数据工作簿是否被打开过。本程序代码中，“C:\文件夹名\文件.xls”、"源工作表名"代表工作簿所在的文件夹和工作簿文件名。 本文来源：https://www.wddqw.com/doc/023de358d0d233d4b04e697c.html