如何修正个人工作簿VBA在薪资导出BACS文件中执行的目标路径问题？

问题描述 #

我将VBA代码存储在个人工作簿中，希望在薪资软件导出的BACS文件（命名为BACS(1)、BACS(2)等）中运行。但执行宏时，新生成的格式化工作表被创建在个人工作簿内，而非当前打开的BACS目标文件中，请问该如何修正？

原代码 #

Sub LFPayrollFPImport() 

Application.ScreenUpdating = False 

    Dim wsSrc As Worksheet 
    Dim wsDest As Worksheet 
    Dim lastRow As Long 
    Dim i As Long 

    ' Set source worksheet as active worksheet 
    Set wsSrc = ThisWorkbook.Activesheet 
    ' Add a new worksheet for output 
    Set wsDest = ThisWorkbook.Sheets.Add(After:=wsSrc) 
    wsDest.Name = "MacroOutput" 
    ' Find the last row with data in column A of source sheet 
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row 
  
    ' Loop through each row and write transformed data 
    For i = 1 To lastRow 
        wsDest.Cells(i, 1).Value = 303265 ' Column A 
        wsDest.Cells(i, 2).Value = "'01645638" ' Column B as text 
        wsDest.Cells(i, 3).Value = 3 ' Column C 
        wsDest.Cells(i, 4).Value = "" ' Column D 
        wsDest.Cells(i, 5).Value = "Lubbock Fine LLP" ' Column E 
        wsDest.Cells(i, 6).Value = "00/00/0000" ' Column F 
        wsDest.Cells(i, 7).Value = 0 ' Column G 
        wsDest.Cells(i, 8).Value = wsSrc.Cells(i, 5).Value ' Column H from column E 
        wsDest.Cells(i, 9).Value = "'" & wsSrc.Cells(i, 1).Text ' Column I from column A 
        wsDest.Cells(i, 10).Value = "'" & wsSrc.Cells(i, 2).Text ' Column J from column B 
        wsDest.Cells(i, 11).Value = "Lubbock Fine LLP" ' Column K 
        wsDest.Cells(i, 12).Value = wsSrc.Cells(i, 7).Value ' Column L from column A 
        wsDest.Cells(i, 13).Value = "" ' Column M 
        wsDest.Cells(i, 14).Value = "" ' Column N 
        wsDest.Cells(i, 15).Value = 1 ' Column O 

    Next i 
    MsgBox "Transformation complete. Output is in sheet: MacroOutput" 

Application.ScreenUpdating = True 

Dim strFullName As String 
Application.DisplayAlerts = False 

strFullName = "P:\Staff Payroll\Lloyds Payment imports" + "\LFPayrollFP.csv" 
ThisWorkbook.Sheets("MacroOutput").Copy 
ActiveWorkbook.SaveAs Filename:=strFullName, FileFormat:=xlCSV, CreateBackup:=True 
ActiveWorkbook.Close 

Application.DisplayAlerts = True 

End Sub 

问题原因 #

代码中使用的ThisWorkbook对象，指向的是宏代码所在的工作簿（即你的个人工作簿），而非当前激活的BACS导出文件。因此所有基于ThisWorkbook的操作都会在个人工作簿内执行，导致新工作表创建位置错误。

修改后的代码 #

将所有ThisWorkbook替换为ActiveWorkbook（该对象指向当前处于激活状态的工作簿，也就是你打开的BACS文件），修改后的代码如下：

Sub LFPayrollFPImport() 

Application.ScreenUpdating = False 

    Dim wsSrc As Worksheet 
    Dim wsDest As Worksheet 
    Dim lastRow As Long 
    Dim i As Long 

    ' Set source worksheet as active worksheet of the current active workbook
    Set wsSrc = ActiveWorkbook.ActiveSheet 
    ' Add a new worksheet for output in the current active workbook
    Set wsDest = ActiveWorkbook.Sheets.Add(After:=wsSrc) 
    wsDest.Name = "MacroOutput" 
    ' Find the last row with data in column A of source sheet 
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, 1).End(xlUp).Row 
  
    ' Loop through each row and write transformed data 
    For i = 1 To lastRow 
        wsDest.Cells(i, 1).Value = 303265 ' Column A 
        wsDest.Cells(i, 2).Value = "'01645638" ' Column B as text 
        wsDest.Cells(i, 3).Value = 3 ' Column C 
        wsDest.Cells(i, 4).Value = "" ' Column D 
        wsDest.Cells(i, 5).Value = "Lubbock Fine LLP" ' Column E 
        wsDest.Cells(i, 6).Value = "00/00/0000" ' Column F 
        wsDest.Cells(i, 7).Value = 0 ' Column G 
        wsDest.Cells(i, 8).Value = wsSrc.Cells(i, 5).Value ' Column H from column E 
        wsDest.Cells(i, 9).Value = "'" & wsSrc.Cells(i, 1).Text ' Column I from column A 
        wsDest.Cells(i, 10).Value = "'" & wsSrc.Cells(i, 2).Text ' Column J from column B 
        wsDest.Cells(i, 11).Value = "Lubbock Fine LLP" ' Column K 
        wsDest.Cells(i, 12).Value = wsSrc.Cells(i, 7).Value ' Column L from column A 
        wsDest.Cells(i, 13).Value = "" ' Column M 
        wsDest.Cells(i, 14).Value = "" ' Column N 
        wsDest.Cells(i, 15).Value = 1 ' Column O 

    Next i 
    MsgBox "Transformation complete. Output is in sheet: MacroOutput" 

Application.ScreenUpdating = True 

Dim strFullName As String 
Application.DisplayAlerts = False 

strFullName = "P:\Staff Payroll\Lloyds Payment imports" + "\LFPayrollFP.csv" 
' Copy the MacroOutput sheet from the current active workbook
ActiveWorkbook.Sheets("MacroOutput").Copy 
ActiveWorkbook.SaveAs Filename:=strFullName, FileFormat:=xlCSV, CreateBackup:=True 
ActiveWorkbook.Close 

Application.DisplayAlerts = True 

End Sub 

关键修改说明 #

• 替换ThisWorkbook为ActiveWorkbook，确保所有工作表操作都针对当前打开的BACS文件
• 保持数据转换逻辑和CSV导出路径不变，不影响原有功能的实现

内容的提问来源于stack exchange，提问作者LARA WALTON