我的雇主最近更新了我们使用的Excel。现在我的VBA代码不再正常工作。

我从另一个程序打开一个.csv文件，因此它在另一个Excel实例中打开，宏所在的已打开的文件看不到它。.csv文件并不是一个已保存的文件，只是打开来复制数据并粘贴到宏工作簿中，然后在不保存的情况下关闭。我需要让Wb1("NewEnrollment") 和Wb("12345.csv") 能够彼此看到，从而让宏从 '.csv' 文件中提取数据。我该怎么让它重新工作？该宏是从WB1运行的。我必须等到回到工作岗位，才能在他们的电脑上查看Excel的版本。我知道最近几个月我们刚升级到Windows 11，并且Excel也已是最新版。

以下Macro是我以前能正常工作的代码：

Sub GetData()

    Dim wb As Workbook ''Source workbook
    Dim wb1 As Workbook '''Destination workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    Set wb1 = Workbooks("New Member Enrollments.xlsm")

    'Check if exactly 2 workbooks are currently open    ''''**This is where I am having issues**.  It is not seeing the workbook.****
    If Application.Workbooks.Count <> 2 Then
        MsgBox "ERROR - There are [" & Application.Workbooks.Count & "] workbooks open." & Chr(10) & _
               "There must be two workbooks open:" & Chr(10) & _
               "-The source workbook (old template)" & Chr(10) & _
               "-The destination workbook"
        Exit Sub
    End If

    For Each wb In Application.Workbooks
        If Right(wb.Name, 4) = ".csv" Then
            'Workbook name ends in number(s), this is the source workbook that will be copied from
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsSource = wb.ActiveSheet
        Else
            'Workbook name does not end in number(s), this is the source workbook that will be pasted to
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsDest = wb1.Sheets("Company Enrollments")
        End If
    Next wb

    'Check if both a source and destination were assigned
    If wsSource Is Nothing Then
        MsgBox "ERROR - Unable to find valid source workbook to copy data from"
        Exit Sub
    ElseIf wsDest Is Nothing Then
        MsgBox "ERROR - Unable to find valid destination workbook to paste data into"
        Exit Sub
    End If

    'The first dimension is for how many times you need to define source and dest ranges, the second dimension should always be 1 to 2
    Dim aFromTo(1 To 2, 1 To 2) As Range
    'Add source copy ranges here:                       'Add destination paste ranges here
    wsSource.Activate

    'Range("A5", Range("A5").End(xlDown)).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo


    Set aFromTo(1, 1) = wsSource.Range("A5:P5", Range("A5:P5").End(xlDown)):       Set aFromTo(1, 2) = wsDest.Range("A2")
    Set aFromTo(2, 1) = wsSource.Range("A5:P5"):      Set aFromTo(2, 2) = wsDest.Range("A2")

    'This will loop through the array of specified FromTo ranges and will ensure that only values are brought over
    Dim i As Long
    For i = LBound(aFromTo, 1) To UBound(aFromTo, 1)
        aFromTo(i, 2).Resize(aFromTo(i, 1).Rows.Count, aFromTo(i, 1).Columns.Count).Value = aFromTo(i, 1).Value
    Next i

Application.CutCopyMode = False

ActiveWorkbook.Close SaveChanges:=False

    wsDest.Activate

Columns("D:G").Delete
Columns("F").Delete

Range("D2").Activate
    ActiveWorkbook.Worksheets("Company Enrollments").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Company Enrollments").Sort.SortFields.Add Key:= _
        Range("D2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Company Enrollments").Sort
        .SetRange Range("A2:K1041")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Application.CutCopyMode = False

Range("A1").Select

Worksheets("Company Enrollments").Activate

Call AddColumnHeaders

解决方案

Here's an example of how you can loop over all open Excel workbooks, regardless of whether they're open in the same instance of Excel as your running code.

基于：启动了多个Excel实例后，如何获取它们的Application对象？

Option Explicit

#If Win64 Then
  Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

  Declare PtrSafe Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
  Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

  Declare Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If

Sub Tester()
    Dim wb As Workbook, ws As Worksheet
    For Each wb In AllOpenWorkbooks()  'in all instances
        Debug.Print wb.Name
        For Each ws In wb.Worksheets
            Debug.Print , ws.Name
        Next ws
    Next wb
End Sub

'Return a collection of all workbooks open in any instance of Excel
Function AllOpenWorkbooks() As Collection
    Dim app As Excel.Application, wb As Excel.Workbook, col As New Collection
    For Each app In GetExcelInstances()
        For Each wb In app.Workbooks
            col.Add wb
        Next wb
    Next app
    Set AllOpenWorkbooks = col
End Function

'Return a collection of all open Excel instances
Private Function GetExcelInstances() As Collection
    Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
    guid(0) = &H20400
    guid(1) = &H0
    guid(2) = &HC0
    guid(3) = &H46000000
    Dim AlreadyThere As Boolean
    Dim xl As Application
    Set GetExcelInstances = New Collection
    Do
        hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
        If hwnd = 0 Then Exit Do
        hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
        hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
        If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
            AlreadyThere = False
            For Each xl In GetExcelInstances
                If xl Is acc.Application Then
                    AlreadyThere = True
                    Exit For
                End If
            Next
            If Not AlreadyThere Then
                GetExcelInstances.Add acc.Application
            End If
        End If
    Loop
End Function

So to modify your current code (after copying the code above into a new code module in your workbook) to check all instances of Excel, it might look like this:

Sub GetData()

    Dim allWorkbooks As Collection
    Dim wb As Workbook ''Source workbook
    Dim wb1 As Workbook '''Destination workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    Set wb1 = ThisWorkbook 'where this code is running
    Set wsDest = wb1.Sheets("Company Enrollments")

    Set allWorkbooks = AllOpenWorkbooks()

    'Check if exactly 2 workbooks are currently open
    If allWorkbooks.Count <> 2 Then
        MsgBox "ERROR - There are [" & allWorkbooks.Count & "] workbooks open." & Chr(10) & _
               "There must be two workbooks open:" & Chr(10) & _
               "-The source workbook (old template)" & Chr(10) & _
               "-The destination workbook"
        Exit Sub
    End If

    'find the csv file
    For Each wb In allWorkbooks
        If Right(wb.Name, 4) = ".csv" Then
            Set wsSource = wb.Worksheets(1) 'csv has only one worksheet
            Exit For 'done looking
        End If
    Next wb

    '...
    'rest of code would be the same...
    '...

End Sub