如何根据动态文件路径从其他工作簿中的单元格中获取值

Question

我想从其他工作簿获取单元格值到我的主文件。

这些文件位于同一文件夹G:\Data\xxx\yyy中，而文件名是客户ID。

即文件路径可能是G:\Data\xxx\yyy\123或G:\Data\xxx\yyy\234我想从这些工作簿中提取的值是在Sheet ABC cell J55中。

因此，我在单元格中输入的公式是= G:\Data\xxx\yyy [123.xlsm]'!$J$55

在主文件中，我在列A中有一个客户ID列表，我想从其他工作簿中的单元格J55获取值。即，创建一个动态文件路径以获取数字并将其粘贴到B列。

但是，我试图将链接与“CONCATENATE”和“G”结合起来，但没有成功。

我尝试了间接功能，但它要求我打开不理想的引用工作簿。

这是我获取数字的方式吗？

VBA编码是受欢迎的。

Answer 1

这是一个可以从Excel VBA运行的解决方案。我承认解决您的问题可能有点过头但它会检查A列的值并填写B列（如果它是所选工作簿的J55中的空白而不打开它们）。它假设您将Microsoft Access作为办公套件的一部分，在64位版本的Windows上运行，您从中检索数据的文件具有.xlsx扩展名，而您希望从J55获取的数据在“Sheet1”上。如果这些假设中的任何一个不正确，请告诉我，因为代码可以轻松调整以适应。

根据您提供的信息，您要访问的所有文件的文件路径似乎是静态的（G：\ Data \ xxx \ yyy），只有文件名是动态的（文件名=来自A列的客户ID＃） ）。您需要引用Microsoft XML v6.0和Microsoft ActiveX Data Objects x.x Library。

下面的代码主要是从我写的另一个项目中剪切和粘贴的。它仍然需要进行测试。我建议添加一些错误处理和正常的性能增强vba代码，如关闭屏幕更新。

Option Explicit

Public Sub Test()

    'Folder where Wb live
    Const FilePath As String = "G:\Data\xxx\yyy\"

    'Command string
    Const request_SQL As String = "SELECT * FROM [Sheet1$]"

    'Get last row
    Dim LastRow As Long
    With ActiveWorkbook.ActiveSheet
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    'Create Array from Main worksheet
    Dim MainWsArray As Variant
    MainWsArray = ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 2))


    Dim FullFileName As String

    'Create a connection to be used throughout the loop
    Dim Cnx As ADODB.Connection
    Set Cnx = New ADODB.Connection

    Dim CustomerId As Long
    Dim RowCounter As Long
    Dim Rst As ADODB.Recordset
    Set Rst = New ADODB.Recordset

    'Loop through Array to get values
    For RowCounter = 1 To LastRow
        If MainWsArray(2, RowCounter) = vbNullString Then
            CustomerId = MainWsArray(1, RowCounter).Value
            FullFileName = FilePath & CustomerId
            AssignCnx Cnx, FullFileName

            'Create RecordSet

            If OpenRecordset(Rst, request_SQL, Cnx) Then
                MsgBox "Unable to open Recordset. " & CustomerId
            End If

            'Use recordset to get data from file.
            Rst.Move 54
            MainWsArray(2, RowCounter) = Rst.Fields(10)
        End If
        Rst.Close
        Cnx.Close
    Next RowCounter

    ActiveWorkbook.ActiveSheet.Range(Cells(1, 2), Cells(LastRow, 2)) = MainWsArray()

    If Not Rst Is Nothing Then Set Rst = Nothing
    If Not Cnx Is Nothing Then Set Cnx = Nothing
End Sub

Public Sub AssignCnx(ByRef Cnx As ADODB.Connection, ByVal FullFileName As String)

    'Connection
    With Cnx
        .Provider = "Microsoft.ACE.OLEDB.12.0" 'or "Microsoft.Jet.OLEDB.4.0" for 32bit
        .ConnectionString = "Data Source=" & FullFileName & _
           ";Extended Properties='Excel 12.0 xml;HDR=NO;IMEX=1;Readonly=False'"
        .Open
    End With

End Sub

Private Function OpenRecordset(ByRef Rst As ADODB.Recordset, ByVal request_SQL As String, ByRef Cnx As ADODB.Connection) As Boolean
    'Error Trapping for the RecordSet

    Dim backupRequestString As String
    On Error Resume Next
    Rst.Open request_SQL, Cnx, adOpenForwardOnly, adLockReadOnly, adCmdText
    If Err.Number = 0 Then
        OpenRecordset = False
        Exit Function
    Else
        Rst.Close
        OpenRecordset = True
        Exit Function
    End If
End Function

我希望你觉得这有帮助。如果它有点多，还有其他方法可以将工作簿链接到没有VBA的Excel中的主文件。自从我这样做以来已经有很长一段时间了。祝你好运。