Word to Project / OutLine Levels

[Bob Inwater]

I have written code that takes the table from word doc and generates a MPP
file. It turned out to be pretty simple except that I not can not figure out
how to indent or change Out Line Level from Word VBA. Ideas?

Thanks,

Bob

 

[Bob Inwater]

Opps .... what I mean is Indent not outline.

 

[Jan De Messemaeker]

Hi Bob,

Did you create an instance of the Project application throught CreateObject?
And did you co,nnenct to Modcrososft project objects through Tools,
References in the VBE?

If no, do so.

Once we're there you cvan lmook up the Project objects through the
objectBrowser.
The method you need here is OutlineIndent.

HTH

 

[Rod Gill]

Easiest way is to record a macro of you doing it manually in Project, then
copy and edit the code into Word. You're looking for the OutlineIndent
method.

 

[Bob Inwater]

Not sure what happened….. it ended up working perfectly… exactly the way I
thought it would work the first time when it did not work. Below is the code
so far in case anyone finds it helpful….. or wants to comment.

Thanks again for taking the time.....

Option Explicit
Dim oRow As Row
Dim oCell As Cell
Dim sCellText As String
Dim i As Integer
Dim C As Integer
Dim Pop As Integer
Dim x As String
Dim Y As Integer
Dim Dev As Variant
Dim DentLevel As Integer

Dim ColOne(1 To 200) As String
Dim ColTwo(1 To 200) As String
Dim ColThree(1 To 200) As String
Dim ColFour(1 To 200) As String
Dim ColFive(1 To 200) As String
Dim ColSix(1 To 200) As String
Dim T As Task
Dim pjApp As MSProject.Application
Dim myProj As MSProject.Project


Sub RetrieveTableItems()
On Error GoTo ErrorHandler
i = 1

' Loop through each row in the table.
For Each oRow In ActiveDocument.Tables(1).Rows 'Index # finds the Table
in question
C = 0
For Each oCell In oRow.Cells ' Loop through each cell in the
current row.
If C = 0 Then
ColOne(i) = oCell.Range
ElseIf C = 1 Then
ColTwo(i) = oCell.Range
ElseIf C = 2 Then
ColThree(i) = oCell.Range
ElseIf C = 3 Then
ColFour(i) = oCell.Range
ElseIf C = 4 Then
ColFive(i) = oCell.Range
ElseIf C = 5 Then
ColSix(i) = oCell.Range

End If

C = C + 1
Next oCell
C = 7
i = i + 1

Next oRow


ErrorHandler:
If Err <> 0 Then
Dim Msg As String
Msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description _
& Chr(13) & "Make sure there is a table in the current document."
MsgBox Msg, , "Error"
End If


OpenProject
MakeMpp
End Sub

Sub CleanCol()

If Left(x, 1) = Chr(12) Then
x = Right(x, Len(x) - 1)
End If

If Right(x, 1) = Chr(12) Then
x = Left(x, Len(x) - 1)
End If
'************************************
If Left(x, 1) = Chr(13) Then
x = Right(x, Len(x) - 1)
End If

If Right(x, 1) = Chr(13) Then
x = Left(x, Len(x) - 1)
End If
'************************************
If Left(x, 1) = Chr(7) Then
x = Right(x, Len(x) - 1)
End If

If Right(x, 1) = Chr(7) Then
x = Left(x, Len(x) - 1)
End If
'************************************
'************************************
If Left(x, 1) = Chr(12) Then
x = Right(x, Len(x) - 1)
End If

If Right(x, 1) = Chr(12) Then
x = Left(x, Len(x) - 1)
End If
'************************************
If Left(x, 1) = Chr(13) Then
x = Right(x, Len(x) - 1)
End If

If Right(x, 1) = Chr(13) Then
x = Left(x, Len(x) - 1)
End If
'************************************
If Left(x, 1) = Chr(7) Then
x = Right(x, Len(x) - 1)
End If

If Right(x, 1) = Chr(7) Then
x = Left(x, Len(x) - 1)
End If
'************************************

End Sub
Sub MakeMpp()


myProj.Tasks.Add ("Phase 1")
Font Bold:=True
DentLevel = 1
Y = Y + 1

For Pop = 2 To 200
x = ColTwo(Pop)
CleanCol


If Not x = "" Then
x = ColOne(Pop)
CleanCol
myProj.Tasks.Add (x)
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Color:=pjBlue
Font Bold:=False
If DentLevel = 1 Then
OutlineIndent
End If
DentLevel = 2

End If
Next Pop
'**************************************


myProj.Tasks.Add ("Phase 2")
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Bold:=True
OutlineOutdent
DentLevel = 1
For Pop = 2 To 200
x = ColTwo(Pop)
CleanCol


If Not x = "" Then
x = ColOne(Pop)
CleanCol
myProj.Tasks.Add (x)
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Color:=pjBlue
Font Bold:=False
If DentLevel = 1 Then
OutlineIndent
End If
DentLevel = 2

End If
Next Pop
'**************************************

myProj.Tasks.Add ("Phase 3")
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Bold:=True
OutlineOutdent
DentLevel = 1
For Pop = 2 To 200
x = ColFour(Pop)
CleanCol


If Not x = "" Then
x = ColOne(Pop)
CleanCol
myProj.Tasks.Add (x)
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Color:=pjBlue
Font Bold:=False
If DentLevel = 1 Then
OutlineIndent
End If
DentLevel = 2

End If
Next Pop
'**************************************

myProj.Tasks.Add ("Phase 4")
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Bold:=True
OutlineOutdent
DentLevel = 1
For Pop = 2 To 200
x = ColFive(Pop)
CleanCol


If Not x = "" Then
x = ColOne(Pop)
CleanCol
myProj.Tasks.Add (x)
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Color:=pjBlue
Font Bold:=False
If DentLevel = 1 Then
OutlineIndent
End If
DentLevel = 2

End If
Next Pop
'**************************************

myProj.Tasks.Add ("Phase 5")
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Bold:=True
OutlineOutdent
DentLevel = 1
For Pop = 2 To 200
x = ColSix(Pop)
CleanCol


If Not x = "" Then
x = ColOne(Pop)
CleanCol
myProj.Tasks.Add (x)
Y = Y + 1
SelectRow Row:=Y, rowrelative:=False
Font Color:=pjBlue
Font Bold:=False
If DentLevel = 1 Then
OutlineIndent
End If
DentLevel = 2

End If
Next Pop
'**************************************
End Sub

Sub OpenProject()
Set pjApp = New MSProject.Application
pjApp.Visible = True
Set myProj = pjApp.Projects.Add
pjApp.ScreenUpdating = False

End Sub

 

[JackD]

Your code seems a bit confusing.
You seem to keep repeating bits of code:

x = ColTwo(Pop)

CleanCol


If Not x = "" Then
x = ColOne(Pop)

x = ColThree(Pop)

CleanCol


If Not x = "" Then
x = ColOne(Pop)

If Left(x, 1) = Chr(12) Then

x = Right(x, Len(x) - 1)
End If

If Right(x, 1) = Chr(12) Then
x = Left(x, Len(x) - 1)
End If

Further you seem to be stripping out Chr(7) which is the ascii bell
character. Is that really in your strings?
Not so sure I've encountered chr(12) - form feed - in any text strings
either.
You can simply use the Replace function to strip any unwanted stuff out.

Sub CleanCol
x = replace(x,Chr(13),"")
x = replace(x,Chr(12),"")
x = replace(x,Chr(7),"")
end Sub

Trim(x) will remove leading and trailing spaces.

I'd be hesitant to use x as a string variable. Usually x is used to refer to
a number.

I'm also not exactly sure why you want to stop at 200. Is that a hard limit
or just a number you figure will be big enough?

 

[Bob Inwater]

Jack,
Thanks a ton for the input. This mac is a First Draft so your comments will
be taken very much to heart when I build the final version.

Bob