避免硬编码路径和错误处理

Question

我是 VBA 的新手，似乎无法理解这个问题。 所以我有一个源 excel 文件，我从选定的工作表中复制必要的数据，然后使用我的宏将其粘贴到主工作簿（日常使用）到确切的工作表。 我想做的是避免对源文件的路径进行硬编码，这样如果源文件名发生变化，它仍然会找到并打开必要的源文件并获取所需的数据。 另外我想实现错误处理以确保源文件存在并且可以在运行宏之前打开。

Sub MacroCopy()
Workbooks.Open "C:\Users\xxxx\OneDrive\Desktop\OneDrive_0000-00-00\Project\Sources\sourcefile.xlsx"

ActiveSheet.ListObjects("Sourcesheet").Range.AutoFilter Field:=16, Criteria1:=Array("1", "2", "3", "4", "5"), Operator:=xlFilterValues

Workbooks("sourceworkbook.xlsx").Worksheets("sourceworksheet").Range("B5:EO11332").Copy _
ThisWorkbook.Worksheets("targetworksheet").Range("B5")

Workbooks("sourceworksheet.xlsx").Close SaveChanges:=True
 
End Sub

Answer 1

几个想法：

---

此代码将尝试打开文件夹中的任何文件 - 在您的评论中，您建议不一定是正确的。

Sub MacroCopy_v2()

    Dim fldr As String, fnm As String, wbSource As Workbook
    fldr = "C:\Users\xxxx\OneDrive\Desktop\OneDrive_0000-00-00\Project\Sources\"

    fnm = Dir(fldr & "*.xlsx")
    
    If fnm = "" Then
        MsgBox "No file found. Aborting."
    Else
        Set wbSource = Workbooks.Open(fldr & fnm)
        wbSource.ActiveSheet.ListObjects("Sourcesheet").Range.AutoFilter Field:=16, Criteria1:=Array("1", "2", "3", "4", "5"), Operator:=xlFilterValues
        wbSource.Worksheets("sourceworksheet").Range("B5:EO11332").Copy _
                            ThisWorkbook.Worksheets("targetworksheet").Range("B5")
        wbSource.Close SaveChanges:=True
    End If
    
End Sub

您可能希望指定工作表名称，而不是使用ActiveSheet ，以防有多个工作表可用。

我也对SaveChanges:=True感到有些困惑 - 因为您没有更改源工作簿（据我所知）。

---

此代码查找默认文件名，如果文件夹中不存在该文件名，则它会打开一个提示，让用户手动 select 一个文件。

Sub MacroCopy_v3()

    Dim fldr As String, defaultfnm As String, openpath As String, wbSource As Workbook
    fldr = "C:\Users\xxxx\OneDrive\Desktop\OneDrive_0000-00-00\Project\Sources"
    
    defaultfnm = "sourcefile.xlsx"
    
    openpath = fldr & "\" & defaultfnm
    If Dir(openpath) = "" Then
        ChDrive "C:"
        ChDir fldr
        openpath = Application.GetOpenFilename("Source file (*.xlsx),*.xlsx")
    End If
    
    If openpath <> "False" Then
        Set wbSource = Workbooks.Open(openpath)
        wbSource.ActiveSheet.ListObjects("Sourcesheet").Range.AutoFilter Field:=16, Criteria1:=Array("1", "2", "3", "4", "5"), Operator:=xlFilterValues
        wbSource.Worksheets("sourceworksheet").Range("B5:EO11332").Copy _
                            ThisWorkbook.Worksheets("targetworksheet").Range("B5")
        wbSource.Close SaveChanges:=True
    Else
        MsgBox "No file selected. Aborting."
    End If
    
End Sub

检测工作表是否存在 - 您可以在此处找到执行此操作的函数：

测试或检查工作表是否存在

您可以做类似的事情来检测 ListObject 是否也存在。