VB宏返回错误1004从persony.xlsb

Question

任何想法？我很难过！我正在运行宏的文件是xlsm。

代码下方

Sub LookupAndRenameWorkbook5()
    Dim lookupValue As Variant
    Dim foundValue As Variant
    Dim sumY As Double
    Dim fcaFilePath As String
    Dim fcaWorkbook As Workbook
    Dim fcaSheet As Worksheet
    Dim lastRow As Long
    Dim dataObj As Object
  
    ' Set the lookup value from column G (assuming the first cell in G2)
    lookupValue = (ThisWorkbook.Sheets(1).Range("G2").Value) ' Trim to remove any leading/trailing spaces
  
    ' Specify the file path for the FCA Register workbook
    fcaFilePath = "\\Path\FINANCE\Commissions\FCA Register for Look Up.xlsx" ' Update this path accordingly
  
    ' Open the FCA Register workbook
    Set fcaWorkbook = Workbooks.Open(fcaFilePath)
    Set fcaSheet = fcaWorkbook.Sheets("Sheet1") ' Reference to Sheet1
  
    ' Find the lookup value in column A of Sheet1
    On Error Resume Next
    foundValue = Application.VLookup(lookupValue, fcaSheet.Range("A:B"), 2, False)
    On Error GoTo 0
  
    ' Check if foundValue is still an error
    If IsError(foundValue) Then
        Debug.Print "Value not found in FCA Register."
    Else
        Debug.Print "Found Value: [" & foundValue & "]"
    End If
  
    ' Sum the contents of column Y in the current workbook
    lastRow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, "Y").End(xlUp).Row
    sumY = Application.WorksheetFunction.Sum(ThisWorkbook.Sheets(1).Range("Y1:Y" & lastRow))
  
    ' Construct the new file name using the found value and the sum of Y
    Dim newFileName As String
    If Not IsError(foundValue) Then
        newFileName = foundValue & " " & sumY & ".xlsm"
    Else
        newFileName = "NoMatch " & sumY & ".xlsm"  ' Default name if no match is found
    End If
  
    ' Save the existing workbook with the new name in the same directory
    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & newFileName ' Save in the same directory
  
    ' Close the FCA Register workbook without saving
    fcaWorkbook.Close SaveChanges:=False
  
    ' Inform the user if the lookup value was not found
    If IsError(foundValue) Then
        MsgBox "Value not found in FCA Register."
    End If
  
    ' Clean up
    Set fcaSheet = Nothing
    Set fcaWorkbook = Nothing
    Set dataObj = Nothing
End Sub

Backup Workbook

快速修复

ThisWorkbook

是包含代码的工作簿，在这种情况下为

PERSONAL.xlsb

Answer 1

ActiveWorkbook

。

保存文件时，要指定正确的文件格式以避免您收到的错误（

PERSONAL.xlsb试图将其保存为.xlsm

文件）。

• Sub LookupAndRenameWorkbook5()
      
      ' Specify the file path for the FCA Register workbook
      Const SRC_FILE_PATH As String = _
          "\\Path\FINANCE\Commissions\FCA Register for Look Up.xlsx"
      
      ' Reference the destination workbook.
      Dim dwb As Workbook: Set dwb = ActiveWorkbook ' the one you're looking at
      ' Or:
      'Dim dwb As Workbook: Set dwb = Workbooks("Current.xlsm") ' you know its name
      
      ' Reference the destination worksheet.
      Dim dws As Worksheet: Set dws = dwb.Sheets(1)
      
      ' Set the lookup value from column G (assuming the first cell in G2)
      Dim LookupValue As Variant:
      LookupValue = dws.Range("G2").Value ' Trim to remove any leading/trailing spaces
      
      ' Open the FCA Register workbook
      Dim swb As Workbook: Set swb = Workbooks.Open(SRC_FILE_PATH)
      Dim sws As Worksheet: Set sws = swb.Sheets("Sheet1")
      
      ' Find the lookup value in column A of Sheet1
      Dim FoundValue As Variant
      On Error Resume Next
          FoundValue = Application.VLookup(LookupValue, sws.Range("A:B"), 2, False)
      On Error GoTo 0
      
      ' Sum the contents of column Y in the current workbook
      Dim LastRow As Long:
      LastRow = dws.Cells(dws.Rows.Count, "Y").End(xlUp).Row
      Dim SumAsString As String: ' assuming there are no errors in column `Y`!!!
      SumAsString = CStr(Application.Sum(dws.Range("Y1:Y" & LastRow)))
      
      Dim NewFileName As String:
      If IsError(FoundValue) Then
          ' Construct the new file name using a string.
          NewFileName = "NoMatch " & SumAsString & ".xlsm"  ' Default name if no match is found
          Debug.Print "Found Value: [" & CStr(FoundValue) & "]"
      Else
          ' Construct the new file name using the found value and the sum of Y
          NewFileName = FoundValue & " " & SumAsString & ".xlsm"
          Debug.Print "Value not found in FCA Register."
      End If
      
      ' Save the existing workbook with the new name in the same directory
      dwb.SaveAs dwb.Path & "\" & NewFileName, xlOpenXMLWorkbookMacroEnabled
      
      ' Close the FCA Register workbook without saving
      swb.Close SaveChanges:=False
      
      ' Inform the user if the lookup value was not found
      If IsError(FoundValue) Then
          MsgBox "Value not found in FCA Register."
      End If
      
  End Sub