Exporting Project to excel using VBA Code

Copper Contributor

Can someone help me I have to export my ms project file to excel but have tried the vba code from some users and there are bugs.

 

We are using Office 365 I looking for anyone who has working code for ms project 2016 to convert to excel

The code I'm currently using is but wont go past the line "Dim xlApp As Excel.Application:

Sub Macro1()
' Macro Macro1
Dim TaskDep As TaskDependency
Dim ts As Tasks
Dim t As Task
Dim y As Long
Dim xlApp As Excel.Application
Dim ws As Worksheet
Dim wb As Workbook
Dim bTaskDepSucc As Boolean

Const consMinInDay As Long = 480

Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Add
Set wb = xlApp.ActiveWorkbook
Set ws = wb.ActiveSheet
xlApp.Visible = True
ws.Cells(1, 1) = "Task UID"
ws.Cells(1, 2) = "Task ID"
ws.Cells(1, 3) = "Task Name"
ws.Cells(1, 4) = "Task Pct Complete"
ws.Cells(1, 5) = "Task Succs"
ws.Cells(1, 6) = "Task Finish"
ws.Cells(1, 7) = "Succ UID"
ws.Cells(1, 8) = "Succ ID"
ws.Cells(1, 9) = "Succ Name"
ws.Cells(1, 10) = "Succ Type"
ws.Cells(1, 11) = "Succ Lag"
ws.Cells(1, 12) = "Succ Pct Complete"
ws.Cells(1, 13) = "Succ Start"
y = 2

WindowActivate TopPane:=True
SelectSheet
Set ts = ActiveSelection.Tasks
For Each t In ts
If (Not t Is Nothing) And (Not t.ExternalTask) And (Not t.Summary) _
And t.ActualFinish = "NA" And InStr(1, t.UniqueIDSuccessors, "SS") > 0 Then
bTaskDepSucc = False
For Each TaskDep In t.TaskDependencies
If t.UniqueID = TaskDep.From Then
If TaskDep.Type = 3 Then
bTaskDepSucc = True
Else
bTaskDepSucc = False
Exit For
End If
End If
Next TaskDep
If bTaskDepSucc Then
For Each TaskDep In t.TaskDependencies
If t.UniqueID = TaskDep.From Then
ws.Cells(y, 1) = t.UniqueID
ws.Cells(y, 2) = t.ID
ws.Cells(y, 3) = t.Name
ws.Cells(y, 4) = t.PercentComplete
ws.Cells(y, 5).NumberFormat = "@"
ws.Cells(y, 5) = t.UniqueIDSuccessors
ws.Cells(y, 6) = Format(t.Finish, "mm/dd/yyyy")
ws.Cells(y, 7) = TaskDep.To.UniqueID
ws.Cells(y, 8) = TaskDep.To.ID
ws.Cells(y, 9) = TaskDep.To.Name
ws.Cells(y, 11) = TaskDep.Lag / consMinInDay
ws.Cells(y, 12) = TaskDep.To.PercentComplete
ws.Cells(y, 13) = Format(TaskDep.To.Start, "mm/dd/yyyy")
y = y
End If
Next TaskDep
End If
End If
Next t
End Sub

 

0 Replies