VBA：从关闭的工作簿中导入数据

Question

我没有找到明确的解决方案来解决这个问题。

我想将所有数据从关闭Ws.Data复制到活动CurrentWs.Data。你们有什么想法怎么做？

Answer 1

尝试用ADODB连接：

Sub copyFromWs() 
Dim Cnx As ADODB.Connection 
Dim fileToCopy As String 
Dim SheetName As String, request_SQL As String 
Dim Rst As ADODB.Recordset 


fileToCopy = "C:\monClasseurBase.xls" 'here you can use something like ws.data.pathname 
SheetName = "Sheet1" 'Here it's your ws.Data 
Set Cnx = New ADODB.Connection 

'Connection 
With Cnx 
    .Provider = "Microsoft.Jet.OLEDB.4.0" 
    .ConnectionString = "Data Source=" & filetocopy & _ 
     ";Extended Properties=Excel 8.0;" 
    .Open 
End With 


'Request 
request_SQL= "SELECT * FROM [" & SheetName & "$]" 

Set Rst = New ADODB.Recordset 
Set Rst = Cnx.Execute(request_SQL) 

Range("A1").CopyFromRecordset Rst 
'Here for you something like currentws.Data.Range("A1").CopyFromRecordset Rst 

'Close 
Cnx.Close 
Set Cnx = Nothing 
End Sub 

Answer 2

此链接是伟大的，从一个封闭的工作簿中的数据复制。

https://www.rondebruin.nl/win/s3/win024.htm

或者，试试这个。

Sub ImportDatafromcloseworkbook() 
'Update 20150707 
Dim xWb As Workbook 
Dim xAddWb As Workbook 
Dim xRng1 As Range 
Dim xRng2 As Range 
Set xWb = Application.ActiveWorkbook 
xTitleId = "KutoolsforExcel" 
With Application.FileDialog(msoFileDialogOpen) 
    .Filters.Clear 
    .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa" 
    .AllowMultiSelect = False 
    .Show 
    If .SelectedItems.Count > 0 Then 
     Application.Workbooks.Open .SelectedItems(1) 
     Set xAddWb = Application.ActiveWorkbook 
     Set xRng1 = Application.InputBox(prompt:="Select source range", Title:=xTitleId, Default:="A1", Type:=8) 
     xWb.Activate 
     Set xRng2 = Application.InputBox(prompt:="Select destination cell", Title:=xTitleId, Default:="A1", Type:=8) 
     xRng1.Copy xRng2 
     xRng2.CurrentRegion.EntireColumn.AutoFit 
     xAddWb.Close False 
    End If 
End With 
End Sub