使用Excel VBA将Excel列数据导入MS Project列的问题求助

原代码核心问题 #

• 新建的MS Project项目初始无任务，For Each tsk In ActiveProject.Tasks循环没有执行对象，直接跳过
• 错误依赖ActiveProject，应直接引用创建好的newproj对象，避免激活状态混乱
• 赋值逻辑完全错误：tsk.Name = tsk.wsTaskList不符合语法，未正确关联Excel单元格值
• 变量冗余：wst与wsOuts重复指向同一工作表，wb未定义

修正后的代码 #

' 打开并新建MS Project文件
Dim pjapp As MSProject.Application
Set pjapp = CreateObject("MSProject.Application")
If pjapp Is Nothing Then
    MsgBox "未安装Microsoft Project"
    Exit Sub
End If
pjapp.Visible = True

Dim newproj As MSProject.Project
Set newproj = pjapp.Projects.Add
newproj.Title = "ExcelExtract"

' 引用Excel目标工作表
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Project_Outline")

' 获取A列实际最后一行（避免遍历空单元格）
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' 遍历Excel数据，导入至MS Project
Dim i As Long
For i = 2 To lastRow
    ' 仅处理A列有内容的行
    If Trim(ws.Cells(i, "A").Value) <> "" Then
        Dim newTask As MSProject.Task
        Set newTask = newproj.Tasks.Add ' 新建任务
        ' 设置任务名称
        newTask.Name = ws.Cells(i, "A").Value
        ' 设置开始日期（判断B列是否为有效日期）
        If IsDate(ws.Cells(i, "B").Value) Then
            newTask.Start = ws.Cells(i, "B").Value
        End If
    End If
Next i

关键说明 #

• 先获取Excel数据的实际最后一行，避免遍历大量空行，提升运行效率
• 通过newproj.Tasks.Add主动创建任务，而非遍历空集合
• 对日期字段做有效性判断，避免无效值导入报错
• 全程使用明确的对象引用（newproj），避免依赖ActiveProject的不确定性

内容的提问来源于stack exchange，提问作者lyonsguy