VBA Excel如何根据部分名称设置工作簿并根据部分名称检查工作簿是否打开

Question

下午好，
我以前从未使用过 VBA，所以我真的需要你的帮助!
我有以下宏(我的第一个)，它工作正常，但在与我们的地区经理测试后，这个文件(“SalesOrderRMTOOL.xlsx”)在他们的计算机上以不同的名称打开。
如何更改我的宏以仅读取部分名称？它将永远是 SalesOrderRMTOOL 但之后它可能是任何东西……？？提前谢谢你的帮助

Private Sub CommandButton1_Click()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim wsTool As Worksheet
    Dim wBook As Workbook
On Error Resume Next
    Set wBook = Workbooks("SalesOrderRMTOOL.xlsx")
    If wBook Is Nothing Then
        MsgBox "Please open SaleOrderRMTOOL file"
        Set wBook = Nothing
        Exit Sub
    End If        
    Set wsSource = Workbooks("SalesOrderRMTOOL.xlsx").Sheets("Salesorder")    
    Set wsTarget = Workbooks("RMORDERTOOL.xlsm").Sheets("Sales Order")        
    Application.ScreenUpdating = False    
    Workbooks("RMORDERTOOL.xlsm").Sheets("Tool").Range("i7:i1003").Value = ""
    Workbooks("RMORDERTOOL.xlsm").Sheets("Tool").Range("l7:l1003").Value = ""
    Workbooks("RMORDERTOOL.xlsm").Sheets("Tool").Range("o7:o1003").Value = ""
    wsTarget.Cells.Clear    
    ' Copy header row to Target sheet if target is empty
    If IsEmpty(wsTarget.Range("A1")) Then wsSource.Rows(1).Copy Destination:=wsTarget.Range("A1")    
        ' Define visible filterd cells on source worksheet and copy
        With wsSource
            .Range("A2", .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column)).SpecialCells(xlCellTypeVisible).Copy
        End With    
        ' Paste to target sheet
        wsTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False

        Application.CutCopyMode = True
        Application.ScreenUpdating = True

        Workbooks("SalesOrderRMTOOL*.xlsx").Close 0

End Sub

Answer 1

我将创建一个简短的函数来返回销售订单工作簿(如果存在)。在带有函数的模块顶部，我会使用一个常量 (Const) 来保存工作簿名称的开头，以防它发生变化:

'Constant at top of module    
Const WORKBOOK_NAME As String = "SalesOrderRMTOOL"

'Anywhere else in same module    
Function GetSalesOrderWb() As Excel.Workbook
Dim wb As Excel.Workbook

For Each wb In Application.Workbooks
    If Left(wb.Name, Len(WORKBOOK_NAME)) = WORKBOOK_NAME Then
        Set GetSalesOrderWb = wb
        Exit Function
    End If
Next
End Function

然后像这样调用它:

Set wBook = GetSalesOrderWb
If wBook Is Nothing Then
    MsgBox "Please open SaleOrderRMTOOL file"
    Exit Sub
End If