MS-Project -> Excel!

Frage: Aus MS-Project sollen Daten nach Excel eingelesen werden. Ziel ist es nun, da in dem Projekt die einzelnen Tasks ständig aktualisiert werden, bestimmte Daten aus dem Projekt in Excel unter Abgleich der eindeutigen ID einzufügen bzw. aktuell zu halten. Die ID steht in Excel im ersten Tabellenblatt in Spalte B. Bei Übereinstimmung soll der Wert aus Project in Spalte M eingetragen werden. Wie geht das?

Hier mal der prinzipielle Zugriff auf Project:

Option Explicit
Public Sub Main()
    Dim objMSProject As Object
    Dim intCount As Integer
    Set objMSProject = GetObject(PathName:="C:\Temp\Test.mpp")
    For intCount = 1 To objMSProject.Resources.Count
        Debug.Print objMSProject.Resources.Item(intCount).Name
        Debug.Print objMSProject.Resources.Item(intCount).BaselineWork
        Debug.Print objMSProject.Resources.Item(intCount).BaselineCost
    Next intCount
    Set objMSProject = Nothing
End Sub
Und hier der Code für die ID in Spalte B:
Option Explicit
Public Sub Main()
    Dim objMSProject As Object
    Dim intCount As Integer
    Dim lngLastRow As Long
    On Error GoTo Fin
    With Tabelle1
        lngLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 2)), _
            .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count)
    End With
    Set objMSProject = GetObject("C:\Temp\Test.mpp")
    For lngLastRow = 2 To lngLastRow
        For intCount = 1 To objMSProject.Tasks.Count
            With objMSProject.Tasks.Item(intCount)
                If Tabelle1.Cells(lngLastRow, 2).Value = .Name Then
                    Tabelle1.Cells(lngLastRow, 13).Value = .Start
                End If
            End With
        Next intCount
    Next lngLastRow
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
    Set objMSProject = Nothing
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...