从 Excel 导入到 MS Project 时出现循环错误

Question

我有一个工具可以读取 Excel 文件并将其转换为 MS Project 项目计划。它还将任务列表 (uniqueID) 打印回电子表格，用于匹配 Excel / 项目任务。这部分工作正常，我正在尝试更新它，以便可以使用 Excel 文件更新现有计划。

以下代码适用于除两个项目任务之外的所有任务，然后循环中断。它还会覆盖前两个任务，而不是仅使用 uniqueID 更新匹配的任务。

 dim statements
 Set prApp = New MSProject.Application

    'If fileToOpen <> False Then

    prApp.FileOpen "c:\users\faizal\desktop\Project1.mpp"

    Set CurrProject = prApp.ActiveProject

    With CurrProject

        Set lshtProjStage2 = ActiveWorkbook.Worksheets("Project Stage - Gate 2")

        lshtProjStage2.Activate


        ' Default place to start.

        llngRowCounter = 10

        llngTaskCounter = 0

        lintBoldCellCount = 0


        lsCellContent = lshtProjStage2.Range("B10").Value

        lblnSkipAddTask = False


        lblnIndentNextCell = False


        lsPreviousCellContent = ""

        llngPerviousCellColour = -4142

        llngPerviousTaskIndentLvl = 0

        lblnPerviousCellBold = False


        lshtProjStage2.Range("G" & Trim(CStr(llngRowCounter))).Select

        lsTaskName = ActiveCell.Value


        lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Select

        start1 = ActiveCell.Value

        llngTaskCounter = llngTaskCounter + 1


        ' Going to loop through cells A10 until we reach "Service Readiness" in column B which is currently on row 28.

            Do While lsCellContent <> ""

            lsCellContent = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter))).Value

            lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter))).Select



                If llngRowCounter >= 10 Then

                lsPreviousCellContent = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter - 1))).Value

                llngPerviousCellColour = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter - 1))).Interior.ColorIndex

                lblnPerviousCellBold = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter - 1))).Font.Bold

                End If


            lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Select

            start1 = ActiveCell.Value


            lshtProjStage2.Range("L" & Trim(CStr(llngRowCounter))).Select

            guid = ActiveCell.Value


            If start1 = "" Then

                lblnSkipAddTask = True

            Else

                lblnSkipAddTask = False

            End If

            c1 = 11


            For Each t In CurrProject.Tasks

                If lblnSkipAddTask = False Then

                ' find the excel file unique id in the Project file based on uniqueid and update

                ' actual start, actual finish, perecent complete and duration

                    If t.UniqueID = guid Then

                    t.Name = start1

                    't.Finish = fin


           'need to exit the code once found to the next line in the excel sheet

            Exit For

                    End If

                End If

            Next t

            c1 = c1 + 1

            llngRowCounter = llngRowCounter + 1

            lsCellContent = lshtProjStage2.Range("B" & Trim(CStr(llngRowCounter))).Value

            ' Check if cell content is <> "" if so carry on else goto Column B.

            If Trim(lsCellContent) = "" Then

                lsCellContent = lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Value & " "

            End If

            ' Check if in column B of this row we have "Service Readiness"

            If lshtProjStage2.Range("C" & Trim(CStr(llngRowCounter))).Value = "Service Readiness" Then

                lsCellContent = ""

            End If

            Loop


    CurrProject.SaveAs

    MsgBox ("Test Text" & CStr(datecount))

CleanExit:

    Exit Sub

    End With

End Sub

Answer 1

1. 仔细查看您存储在 L 列中的任务唯一 ID（或称它们为 GUID）。前两个任务的任务唯一 ID 是否存在两次？
2. 此代码中仅更新任务名称，并使用 C 列（开始）中的值进行更新；这看起来不正确。
3. 您的代码缩进已关闭，这可能会导致代码似乎执行了一些它没有执行的操作 - 请修复您的缩进。
4. End With 语句的位置错误 - 将其移到 Loop 行之后。
5. 如果您想更新实际值，请务必使用任务属性t.ActualStart 和t.ActualFinish。