后台打开工作簿读取内容源码:
Sub subOpenWorkbook() Dim datebase As String datebase = "... ....xlsx" Application.ScreenUpdating = False '关闭屏幕 Workbooks.Open datebase, ReadOnly:=True '只读方式打开工作簿 Dim oWB As Workbook Set oWB = ActiveWorkbook ThisWorkbook.Activate '代码所在的工作簿设为活动 Application.ScreenUpdating = True '打开屏幕 MsgBox "pause" ThisWorkbook.Sheets(1).Range("A1") = oWB.Sheets(1).Range("A1") '取内容 oWB.Close SaveChanges:=False '关闭不保存工作簿 End Sub
不打开工作簿读取内容源码:
Public Function GetCellValue(strPath As String, strFile As String, strSheet As String, strA1 As String) If Right(strPath, 1) <> "" Then strPath = strPath & "" '最后一位不是就加上 If Dir(strPath & strFile) = "" Then '判断文件是否存在 Err.Raise 12345, "GetCellValue", "NO found file" Exit Function End If GetCellValue = ExecuteExcel4Macro("'" & strPath & "[" & strFile & "]" & strSheet & "'!" & Range(strA1).Address(, , xlR1C1)) Rem 'Debug.Print "'" & strPath & "[" & strFile & "]" & strSheet & "'!" & Range(strA1).Address(, , xlR1C1) Rem 一个不带等号的 Microsoft Excel 4.0 宏语言函数。所有引用必须是像 R1C1 这样的字符串。 Rem 如果 String 内包含嵌套的双引号,则必须写两个。例如,要运行宏函数 =MID("sometext",1,4),String 必须为 "MID(""sometext"",1,4)"。 End Function Sub 不打开工作簿读取内容() Dim strPath As String Dim strFile As String Dim strSheet As String Dim strResult As String Dim strCell As String strPath = "D:aaa" strFile = "bbb.xlsx" strSheet = "Sheet1" strCell = "A1" strResult = GetCellValue(strPath, strFile, strSheet, strCell) ThisWorkbook.Sheets(1).Range("A1") = strResult End Sub