Question

我是VBA的新手，所以请在这里忍受。

使用定义的文件夹（我们将其称为“上传文件夹”）中的文件更新主文件（KAM客户计划）时遇到了一些麻烦。

我想做的是：

一个个地打开上载文件夹中包含的文件
将其中的帐户代码（单元格E5）与主文件（列A）中显示的帐户代码匹配
- 如果出现匹配项，则更新同一行中的相关单元格
- 如果没有插入新行，并在底部显示信息
然后使用单元格创建文件夹路径，将选中的文件发送到该路径，然后将其从上传文件夹中删除
重复执行该文件夹中的所有文件

我目前所拥有的似乎只使用第一个文件来更新主列表，然后其他所有文件都被归档并清理而不进行更新。

它已经接近工作了，但我无法完全完成最后一步。

这是我到目前为止所拥有的：

Sub KAMtemplateupload()
    Application.ScreenUpdating = False

    Dim wb As Workbook
    Dim y As Workbook
    Dim actrow As Integer

    Dim folderPath As String
    Dim filename As String

    folderPath = "C:\test\test\"

    filename = Dir(folderPath & "*.xlsx")
    Do Until filename = ""
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & filename)
        Set y = Workbooks.Open("C:\test\KAM - Account Plan spreadsheet template -sample.xlsx")

        actrow = y.Sheets("Sheet1").Cells(y.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Offset(1).Row

        Dim r As Variant
        Dim Lastrow As Long
        Dim rng As Range

        With y.Sheets("Sheet1")
            Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set rng = .Range("A:A")
            r = Application.Match(wb.Sheets("Sheet1").Range("E5"), rng, False)
            If Not IsError(r) Then
                'update
                .Cells(CLng(r), 3).Value = wb.Sheets("Sheet1").Range("C6")
                .Cells(CLng(r), 4).Value = wb.Sheets("Sheet1").Range("E6")
            Else
                'new
                'name
                wb.Sheets("Sheet1").Range("C5").Copy
                y.Sheets("Sheet1").Range("B" & actrow).PasteSpecial xlPasteValues
                'acctcode
                wb.Sheets("Sheet1").Range("E5").Copy
                y.Sheets("Sheet1").Range("A" & actrow).PasteSpecial xlPasteValues
                'policytotal
                wb.Sheets("Sheet1").Range("C6").Copy
                y.Sheets("Sheet1").Range("C" & actrow).PasteSpecial xlPasteValues
                'membertotal
                wb.Sheets("Sheet1").Range("E6").Copy
                y.Sheets("Sheet1").Range("D" & actrow).PasteSpecial xlPasteValues

            End If
        End With

        Const MYPATH As String = "C:\test\test\"

        Dim part3 As String

        part3 = wb.Sheets("Sheet1").Range("E4").Value

        If Len(Dir(MYPATH & part3, vbDirectory)) = 0 Then
            MkDir MYPATH & part3
        End If

        wb.SaveCopyAs "C:\test\test\" & part3 & "\" & "ER group renewal notes - " & wb.Sheets("Sheet1").Range("C5") & ".xlsx"
        wb.ChangeFileAccess xlReadOnly
        Kill wb.FullName

        filename = Dir(folderPath & "*.xlsx")

    Loop

    Application.ScreenUpdating = True

End Sub

当我运行它时，我还会得到一条提示：“是否要在更改文件状态之前保存更改？”

我发现设置ReadOnly状态有点复杂，但是如果我不将其设置为ReadOnly，那么它将不允许我杀死文件。

任何帮助将不胜感激。

谢谢！

Answer 1

我尝试了Nick和S.Serp的建议更改，这些更改导致了解决方案-谢谢！

似乎用wb.Close SaveChanges:=False关闭了更新文件，而缺少了Set代码的位置。

奇怪的是，在循环关闭之前从filename=Dir中删除较长的引用会导致它在这种情况下不起作用。它给出“无效的过程调用或参数”。但是，保留较长的引用，可以正常工作。

作为参考，现在对代码所做的更改为：

（将Set命令移出循环）

Set y = Workbooks.Open("C:\test\KAM - Account Plan spreadsheet template -sample.xlsx")

Do Until filename = ""
     Set wb = Workbooks.Open(folderPath & filename)

和

（关闭工作簿）

wb.SaveCopyAs "C:\test\test\" & part3 & "\" & "ER group renewal notes - " & wb.Sheets("Sheet1").Range("C5") & ".xlsx"
wb.ChangeFileAccess xlReadOnly
kill wb.FullName
wb.Close SaveChanges:=False

    filename = Dir(folderPath & "*.xlsx")

    Loop

Excel VBA从文件夹中的文件更新主列表

1 个答案: