更改文件名時自動更新宏

Question

我有以下宏來過濾具有員工小時文件的我的目錄中的特定數據，並將其放入我的zmaster文件中。但是，我需要各種項目的各種主文檔（例如更改名稱爲「項目300000」）。當我將主文件名從zmaster更改爲其他任何內容時，我的宏顯然找不到相應的文件。

有沒有辦法改變我的宏，使得zmaster.xlsm在我的宏中被當前文件名自動替換？

Option Explicit 

Sub CopyToMasterFile() 

    Dim MasterWB As Workbook 
    Dim MasterSht As Worksheet 
    Dim MasterWBShtLstRw As Long 
    Dim FolderPath As String 
    Dim TempFile 
    Dim CurrentWB As Workbook 
    Dim CurrentWBSht As Worksheet 
    Dim CurrentShtLstRw As Long 
    Dim CurrentShtRowRef As Long 
    Dim CopyRange As Range 
    Dim ProjectNumber As String 


    FolderPath = "C:\test\" 
    TempFile = Dir(FolderPath) 

    Dim WkBk As Workbook 
    Dim WkBkIsOpen As Boolean 

    'Check if zmaster is open already 
    For Each WkBk In Workbooks 
     If WkBk.Name = "zmaster.xlsm" Then WkBkIsOpen = True 
    Next WkBk 

    If WkBkIsOpen Then 
     Set MasterWB = Workbooks("zmaster.xlsm") 
     Set MasterSht = MasterWB.Sheets("Sheet1") 
    Else 
     Set MasterWB = Workbooks.Open(FolderPath & "zmaster.xlsm") 
     Set MasterSht = MasterWB.Sheets("Sheet1") 
    End If 

    ProjectNumber = MasterSht.Cells(1, 1).Value 



    Do While Len(TempFile) > 0 

     'Checking that the file is not the master and that it is a xlsx 
     If Not TempFile = "zmaster.xlsm" And InStr(1, TempFile, "xlsx", vbTextCompare) Then 

      Set CopyRange = Nothing 

      'Note this is the last used Row, next empty row will be this plus 1 
      With MasterSht 
       MasterWBShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row 
      End With 

      Set CurrentWB = Workbooks.Open(FolderPath & TempFile) 
      Set CurrentWBSht = CurrentWB.Sheets("Sheet1") 

      With CurrentWBSht 
       CurrentShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row 
      End With 

      For CurrentShtRowRef = 1 To CurrentShtLstRw 

      If CurrentWBSht.Cells(CurrentShtRowRef, "A").Value = ProjectNumber Then 

       'This is set to copy from Column A to Column L as per the question 

       If CopyRange Is Nothing Then 
       'If there is nothing in Copy range then union wont work 
       'so first row of the work sheet needs to set the initial copyrange 
        Set CopyRange = CurrentWBSht.Range("A" & CurrentShtRowRef & _ 
               ":L" & CurrentShtRowRef) 
       Else 
        'Union is quicker to be able to copy from the sheet once 
        Set CopyRange = Union(CopyRange, _ 
             CurrentWBSht.Range("A" & CurrentShtRowRef & _ 
                  ":L" & CurrentShtRowRef)) 
       End If ' ending If CopyRange Is Nothing .... 
      End If ' ending If CurrentWBSht.Cells.... 

      Next CurrentShtRowRef 

      CopyRange.Select 

      'add 1 to the master file last row to be the next open row 
      CopyRange.Copy MasterSht.Cells(MasterWBShtLstRw + 1, 1) 

      CurrentWB.Close savechanges:=False 

     End If  'ending   If Not TempFile = "zmaster.xlsx" And .... 

     TempFile = Dir 

    Loop 

ActiveSheet.Range("A1:L200").RemoveDuplicates Columns:=Array(1, 2, 4, 8, 9, 10, 11, 12), Header:=xlYes 

End Sub 

Answer 1

從一個硬編碼的工作簿名逃脫的方法是使用ActiveWorkbook或ThisWorkbook對象 - 他們都返回Workbook對象的實例。

ThisWorkbook

Returns a Workbook object that represents the workbook where the current macro code is running. Read-only.

ActiveWorkbook

Returns a Workbook object that represents the workbook in the active window (the window on top). Read-only. Returns Nothing if there are no windows open or if either the Info window or the Clipboard window is the active window.

然後你就可以使用返回Workbook對象的Name屬性來獲取工作簿的名稱。

---

另一種方式可能是，如果你將這樣的數據作爲參數傳遞給你的函數。 例如：

Sub CopyToMasterFile(wbName as String, sheetName as String) 

在這個變體，如果你從另一個宏代碼調用您的Sub，你可以通過任何你想使用 - 這個方法可以逃避硬編碼的東西在你的函數。

這也適用於Worksheet對象 - 對ActiveSheet