求助：如何使用vba实现，在不打开已知路径的excel文件的情况下，将里面的sheet1中的内容复制到当前excel

Question

如何使用vba实现，在不打开已知路径的excel文件的情况下，将里面的sheet1中的内容复制到当前excel文件的sheet中？
最终想实现双击文本框选取一文件，点击【读入】，将信息拷贝到当前sheet中。
哪位大侠帮忙解决下？

Answer 1

不打开文件的情况似乎只有数据库访问方式才可以，把要访问的excel文件作为一个数据库。这样的话你要动态链接数据库，很麻烦
一般人都用欺骗的方式吧，就是不刷屏，并把打开的excel隐藏，读取后再关闭，和没有打开看起来是一样的

追问

欺骗的方法听说过，怎么实现能写出代码吗？谢谢！！！显示选择文件的路径和读入拷贝文件到当前sheet是两个单独操作。

追答

一下代码把新打开的文件的sheet1copy到始终打开的excel中的sheet4.你可以在双击文本框对应的sub中调用getfilename，在“读入”对应的sub中调用copysheet
Option Explicit
Private filename As String
Sub test()
getfilename
copysheet
End Sub

Sub getfilename()

Dim lngCount As Long

' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show

filename = .SelectedItems(1)
End With

End Sub
Sub copysheet()
Dim openedWorkbook As Workbook
Application.ScreenUpdating = False
Set openedWorkbook = Workbooks.Open(filename)
openedWorkbook.Sheets(1).UsedRange.copy Destination:=Workbooks("始终打开的excel文件.xls").Sheets(4).Range("A1")
openedWorkbook.Close savechanges:=False
Set openedWorkbook = Nothing
Application.ScreenUpdating = True
End Sub

Answer 2

Option Explicit
Sub 取值(路径 As String, 文件 As String, 工作表, 单元格 As String)
On Error Resume Next
Dim rng As Range
Sheets("Sheet1").UsedRange.Clear
[a1].Activate
Set rng = ActiveCell.Resize(Range(单元格).Rows.Count, Range(单元格).Columns.Count)
If Err <> 0 Then
MsgBox "请调整区域,当前区域不足以存放引用区域的值" _
& Chr(10) & "建议选择A1再执行程序", 64, "提示"
Exit Sub
End If
'将目标区域复制到以当前表活动单元格为左上角的相同大小的区域中
With ActiveCell.Resize(Range(单元格).Rows.Count, Range(单元格).Columns.Count)
'在指定区域输入公式，该公式引用指定路径下的工作表数据，可以是单元格也可以是区域
.FormulaArray = "='" & 路径 & "\[" & 文件 & "]" & 工作表 & "'!" & 单元格
'将公式转换成值
.Value = .Value
End With
End Sub

Sub 提取数据()
取值 ThisWorkbook.Path & "\文件", "附件1.xls", "新发生", "A1:B50"
'文件，附件1，新发生 等信息可自行修改成自己需要的
End Sub

Answer 3

http://club.excelhome.net/forum.php?mod=viewthread&tid=395683&page=25#pid2564663