Attribute VB_Name = "MPP2HTML"
Private Declare Function RegisterClipboardFormat Lib "User32" _
Alias "RegisterClipboardFormatA" (ByVal lpString As String) _
As Long
Sub MPP2HTML()
' Macro uses the current project and exports it to HTML with useful Tags für further formatting
'
' Every Item is a Headline based on the deepness
' Properties are stored as text with classes
' Important: Notes are stored as "text" only (limitation of Project COM)
'
Dim item As Task
Dim strReport, strNotes As String
Dim strLine As String
Dim blnulflag As Boolean
Dim arrNotes
Dim count As Integer
Dim vbvt: vbvt = Chr(11) ' VerticalTab
strReport = ""
strReport = strReport & "
" & vbCrLf
strReport = strReport & "Vorgangsnummer: | " & item.ID & " | " & vbCrLf _
& "Vorgänger: | " & item.Predecessors & "  | " & vbCrLf _
& "
" & vbCrLf
If item.PercentComplete = "100" Then
strReport = strReport & "Abgeschlossen: | " & item.PercentComplete & " | " & vbCrLf
ElseIf item.PercentComplete = "0" Then
strReport = strReport & "Abgeschlossen: | " & item.PercentComplete & " | " & vbCrLf
Else
strReport = strReport & "Abgeschlossen: | " & item.PercentComplete & " | " & vbCrLf
End If
strReport = strReport & "Dauer (min): | " & item.Duration & " | " & vbCrLf
strReport = strReport & "
" & vbCrLf
' Special handling für Notes.
' If starting with a "<", assume HTML and copy 1:1
' Otherwise look für "." at the beginning, to generate unnumbered List
strNotes = encodehtml(item.Notes)
strNotes = Replace(strNotes, vbvt, "
") ' VerticalTab =
If (IsEmpty(strNotes) Or (strNotes = "")) Then
strNotes = "Keine Notizen"
Else
Debug.Print " Notes gefunden"
arrNotes = Split(strNotes, vbCr)
blnulflag = False
strNotes = ""
für count = 0 To uBound(arrNotes)
strLine = arrNotes(count)
If InStr(strLine, ".") = 1 Then
' Enumeration detected
If blnulflag = False Then ' start new uL
strNotes = strNotes & "
- " & Mid(strLine, 2) & "
" & vbCrLf
blnulflag = True
Else ' uL already active, add Entry
strNotes = strNotes & "- " & Mid(strLine, 2) & "
" & vbCrLf
End If
Else ' Normal String
If blnulflag = False Then
strNotes = strNotes & strLine & vbCrLf
Else
blnulflag = False
strNotes = strNotes & "
" & vbCrLf & strLine & vbCrLf
End If
End If
Next
If blnulflag Then ' closing uL Tag if last line
strNotes = strNotes & "" & vbCrLf
End If
'strNotes = Replace(strNotes, vbCr, "
" & vbCrLf)
End If
strReport = strReport & strNotes & vbCrLf
End If
Next
strReport = strReport + ""
Dim strClipText As String
' http://blogs.msdn.com/jmstall/pages/sample-code-html-clipboard.aspx
Dim header As String: header = "Format:HTML Format" & vbCrLf _
& "Version:1.0" & vbCrLf _
& "StartHTML:<<<<<<<1" & vbCrLf _
& "EndHTML:<<<<<<<2" & vbCrLf _
& "StartFragment:<<<<<<<3" & vbCrLf _
& "EndFragment:<<<<<<<4" & vbCrLf _
& "StartSelection:<<<<<<<3" & vbCrLf _
& "EndSelection:<<<<<<<3" & vbCrLf
Dim pre As String: pre = "" & vbCrLf _
& "
NoTitle"
Dim post: post = ""
strClipText = header
Dim startHTML As Integer: startHTML = Len(strClipText)
strClipText = strClipText + pre
Dim fragmentStart As Integer: fragmentStart = Len(strClipText)
strClipText = strClipText + strReport
Dim fragmentEnd As Integer: fragmentEnd = Len(strClipText)
strClipText = strClipText + post
Dim endHTML As Integer: endHTML = Len(strClipText)
strClipText = Replace(strClipText, "<<<<<<<1", startHTML)
strClipText = Replace(strClipText, "<<<<<<<2", endHTML)
strClipText = Replace(strClipText, "<<<<<<<3", fragmentStart)
strClipText = Replace(strClipText, "<<<<<<<4", fragmentEnd)
Dim nCFHTML As Long: nCFHTML = RegisterClipboardFormat("HTML Format")
Dim oData As DataObject
Set oData = New DataObject
oData.Clear
oData.SetText StrConv(strClipText, vbFromUnicode), nCFHTML
oData.PutInClipboard
Debug.Print "Writing to:" & ActiveProject.FullName + ".htm"
fnum = FreeFile()
Open ActiveProject.FullName + ".htm" für Output As fnum
Write #fnum, strReport
Close #fnum
End Sub
Function encodehtml(strInput As String) As String
Dim strtemp
strtemp = strInput
strtemp = Replace(strtemp, Chr(9), "
")
strtemp = Replace(strtemp, Chr(11), "
")
strtemp = Replace(strtemp, Chr(38), "&")
strtemp = Replace(strtemp, Chr(160), " ")
strtemp = Replace(strtemp, Chr(161), "¡")
strtemp = Replace(strtemp, Chr(162), "¢")
strtemp = Replace(strtemp, Chr(163), "£")
strtemp = Replace(strtemp, Chr(164), "¤")
strtemp = Replace(strtemp, Chr(165), "¥")
strtemp = Replace(strtemp, Chr(166), "¦")
strtemp = Replace(strtemp, Chr(167), "§")
strtemp = Replace(strtemp, Chr(168), "ü")
strtemp = Replace(strtemp, Chr(169), "©")
strtemp = Replace(strtemp, Chr(170), "ª")
strtemp = Replace(strtemp, Chr(171), "«")
strtemp = Replace(strtemp, Chr(172), "¬")
strtemp = Replace(strtemp, Chr(173), "")
strtemp = Replace(strtemp, Chr(174), "®")
strtemp = Replace(strtemp, Chr(175), "¯")
strtemp = Replace(strtemp, Chr(176), "°")
strtemp = Replace(strtemp, Chr(177), "±")
strtemp = Replace(strtemp, Chr(178), "²")
strtemp = Replace(strtemp, Chr(179), "³")
strtemp = Replace(strtemp, Chr(180), "´")
strtemp = Replace(strtemp, Chr(181), "µ")
strtemp = Replace(strtemp, Chr(182), "¶")
strtemp = Replace(strtemp, Chr(183), "·")
strtemp = Replace(strtemp, Chr(183), "¸")
strtemp = Replace(strtemp, Chr(185), "¹")
strtemp = Replace(strtemp, Chr(186), "º")
strtemp = Replace(strtemp, Chr(187), "»")
strtemp = Replace(strtemp, Chr(188), "¼")
strtemp = Replace(strtemp, Chr(189), "½")
strtemp = Replace(strtemp, Chr(190), "¾")
strtemp = Replace(strtemp, Chr(191), "¿")
strtemp = Replace(strtemp, Chr(192), "À")
strtemp = Replace(strtemp, Chr(193), "Á")
strtemp = Replace(strtemp, Chr(194), "Â")
strtemp = Replace(strtemp, Chr(195), "Ã")
strtemp = Replace(strtemp, Chr(196), "Ä")
strtemp = Replace(strtemp, Chr(197), "Å")
strtemp = Replace(strtemp, Chr(198), "Æ")
strtemp = Replace(strtemp, Chr(199), "Ç")
strtemp = Replace(strtemp, Chr(200), "È")
strtemp = Replace(strtemp, Chr(201), "É")
strtemp = Replace(strtemp, Chr(202), "Ê")
strtemp = Replace(strtemp, Chr(203), "Ë")
strtemp = Replace(strtemp, Chr(204), "Ì")
strtemp = Replace(strtemp, Chr(205), "Í")
strtemp = Replace(strtemp, Chr(206), "Î")
strtemp = Replace(strtemp, Chr(207), "Ï")
strtemp = Replace(strtemp, Chr(208), "Ð")
strtemp = Replace(strtemp, Chr(209), "Ñ")
strtemp = Replace(strtemp, Chr(210), "Ò")
strtemp = Replace(strtemp, Chr(211), "Ó")
strtemp = Replace(strtemp, Chr(212), "Ô")
strtemp = Replace(strtemp, Chr(213), "Õ")
strtemp = Replace(strtemp, Chr(214), "Ö")
strtemp = Replace(strtemp, Chr(215), "×")
strtemp = Replace(strtemp, Chr(216), "Ø")
strtemp = Replace(strtemp, Chr(217), "Ù")
strtemp = Replace(strtemp, Chr(218), "Ú")
strtemp = Replace(strtemp, Chr(219), "Û")
strtemp = Replace(strtemp, Chr(220), "Ü")
strtemp = Replace(strtemp, Chr(221), "Ý")
strtemp = Replace(strtemp, Chr(222), "Þ")
strtemp = Replace(strtemp, Chr(223), "ß")
strtemp = Replace(strtemp, Chr(224), "à")
strtemp = Replace(strtemp, Chr(225), "á")
strtemp = Replace(strtemp, Chr(226), "â")
strtemp = Replace(strtemp, Chr(227), "ã")
strtemp = Replace(strtemp, Chr(228), "ä")
strtemp = Replace(strtemp, Chr(229), "å")
strtemp = Replace(strtemp, Chr(230), "æ")
strtemp = Replace(strtemp, Chr(231), "ç")
strtemp = Replace(strtemp, Chr(232), "è")
strtemp = Replace(strtemp, Chr(233), "é")
strtemp = Replace(strtemp, Chr(234), "ê")
strtemp = Replace(strtemp, Chr(235), "ë")
strtemp = Replace(strtemp, Chr(236), "ì")
strtemp = Replace(strtemp, Chr(237), "í")
strtemp = Replace(strtemp, Chr(238), "î")
strtemp = Replace(strtemp, Chr(239), "ï")
strtemp = Replace(strtemp, Chr(240), "ð")
strtemp = Replace(strtemp, Chr(241), "ñ")
strtemp = Replace(strtemp, Chr(242), "ò")
strtemp = Replace(strtemp, Chr(243), "ó")
strtemp = Replace(strtemp, Chr(244), "ô")
strtemp = Replace(strtemp, Chr(245), "õ")
strtemp = Replace(strtemp, Chr(246), "ö")
strtemp = Replace(strtemp, Chr(247), "÷")
strtemp = Replace(strtemp, Chr(248), "ø")
strtemp = Replace(strtemp, Chr(249), "ù")
strtemp = Replace(strtemp, Chr(250), "ú")
strtemp = Replace(strtemp, Chr(251), "û")
strtemp = Replace(strtemp, Chr(252), "ü")
strtemp = Replace(strtemp, Chr(253), "ý")
strtemp = Replace(strtemp, Chr(254), "þ")
strtemp = Replace(strtemp, Chr(255), "ÿ")
encodehtml = strtemp
End Function