在保存事件（VBA）上打开另一个工作簿

因此，在我的“Thisworkbook”模块中有下面的代码。我需要它在用户保存工作簿时运行。代码将打开另一个工作簿并将数据传输到新工作簿中

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Exit Sub
On Error Resume Next
Dim Mas_loc As String

Mas_loc = "C:\Users\J03800\Documents\All Folders\Berry\MasterBerry.xlsx"




Dim n As Integer
Dim m As Integer
Dim x As Integer
Dim y As Integer
Dim PartNumber As String
Dim CageCode As String
Dim PartCage As String
Dim MI As Integer
Dim ChildWB As Workbook
Dim MasterWB As Workbook
Dim IsMatch As Boolean
Dim ChiMain As Worksheet
Dim MasMain As Worksheet



Set ChildWB = ActiveWorkbook
Set MasterWB = Workbooks.Open(Mas_loc)

Set ChiMain = ChildWB.Sheets("Main")
Set MasMain = MasterWB.Sheets("Main")
n = Application.CountA(ChiMain.Range("B:B")) + 1
m = Application.CountA(MasMain.Range("B:B")) + 1

ChildWB.Activate

For x = 3 To n
    PartNumber = ChiMain.Cells(x, "B").Value
    CageCode = ChiMain.Cells(x, "A").Value
    CSMC = ChiMain.Cells(x, "J").Value
    CMC = ChiMain.Cells(x, "L").Value
    MassObj = ChiMain.Cells(x, "E").Value
    ComObj = ChiMain.Cells(x, "H").Value

    If Len(PartNumber) > 0 Then
        If Len(CageCode) > 1 Then
            PartNumber = "-" & Replace(Replace(PartNumber, CageCode & "-", ""), "-" & CageCode, "")
            PartCage = "Cage-" & CageCode & "-" & PartNumber
        Else
            PartCage = "NoCage-" & PartNumber
        End If
    Else
        PartCage = ""
    End If

    On Error GoTo NewPart
    MatchAddress = Application.WorksheetFunction.Match(PartCage, MasMain.Range("K1:K" & m + 20), 0)

    contin:
    On Error Resume Next
    If Len(CSMC) > 0 And Len(Replace(CSMC, "?", "")) = Len(CSMC) And Len(MasMain.Cells(MatchAddress, "E").Value) = 0 Then
        MasMain.Cells(MatchAddress, "E").Value = CSMC
    End If

    If Len(CMC) > 0 And Len(Replace(CMC, "?", "")) = Len(CMC) And Len(MasMain.Cells(MatchAddress, "H").Value) = 0 Then
        MasMain.Cells(MatchAddress, "H").Value = CMC
    End If

    If Len(MassObj) > 0 And Len(Replace(MassObj, "?", "")) = Len(MassObj) And Len(MasMain.Cells(MatchAddress, "C").Value) = 0 Then
        MasMain.Cells(MatchAddress, "C").Value = MassObj
    End If

    If Len(MassObj) > 0 And Len(Replace(MasMain.Cells(MatchAddress, "C").Value, ComObj, "")) = MasMain.Cells(MatchAddress, "C").Value Then
        MasMain.Cells(MatchAddress, "G").Value = MasMain.Cells(MatchAddress, "G").Value & Chr(10) & ComObj
    End If


Next

MasterWB.Close SaveChanges:=True
Exit Sub
    NewPart:
        On Error Resume Next
        m = m + 1
        MatchAddress = m
        MasMain.Cells(MatchAddress, "A").Value = ChiMain.Cells(MatchAddress, "A").Value
        MasMain.Cells(MatchAddress, "B").Value = ChiMain.Cells(MatchAddress, "B").Value
        MasMain.Cells(MatchAddress, "K").Value = PartCage
        GoTo contin

    End Sub

---

问题似乎是它没有打开MasterWB。正如，当它出错时，MasterWB既没有打开，又根据代码等于零。我应该更改什么？

您的代码块看起来很好-假设在

Mas\u loc

中指定的路径是准确的

• 当它“出错”时，你会得到什么错误
• 您是否已通过代码查看发生了什么

---

我会在下一步注释掉

On Error Resume

语句，以停止掩盖任何运行时错误。

我使sub不是私有的，然后它工作了

它说块未设置，当我悬停在“MasterWB”上时，它说它不等于任何东西。接下来的错误恢复，是我试图找出错误所在，并绕过我认为是另一个错误的一部分。我还多次运行了代码，但它仍然无法打开masterWB。我也相当肯定这条路是正确的。我创建了一个快捷方式，并在我第一次注意到这个问题后进行了复制，以便再次检查。