none
Export specific task Uniques ID's from Project file to excel RRS feed

  • Question

  • Dear all, 

    I have used the John code. it works perfectly! I have a question how can we export Unique Id's instead of Task ID's

    Macro written by John - Project
    'Version 1.5 7/24/18 11:00 am
    '   updates & fixes (oldest to most current)
    '   *added declaration for index variables
    '   *included separate procedure for checking object library references
    '   *changed array dimension statements for active selection so procedure works with consolidated files
    '   *changed all constant designations for line feed and carriage return
    '   *added declaration for remaining undeclared variables
    '   *changed code to recognize and handle vertical tabs
    '   *fixed problem with writing to caption that occurs with some Windows installations
    '   *changed export to scheduled start/finish instead of baseline start/finish
    '   *added Resource Names field to export and version number as variable
    '   *added statement to reset "on error goto" after Excel is called
    '   *added format for date value in Excel to only show date without the time
    '   *removed license agreement for public release
    '   *added statement to remove horizontal tabs from Notes string
    Option Explicit
    Option Compare Text
    Public Const ver = " - 1.5"
    Sub Export_Notes_Text_NBL()
    Dim TskID() As Integer
    Dim TskNam() As String
    Dim ResNam() As String
    Dim SStart() As Date
    Dim SFinish() As Date
    Dim TskNot() As String
    Dim NumTsk As Integer, i As Integer, j As Integer, RowIndex As Integer
    Dim BookNam As String
    Dim As Task
    Dim Xl As Excel.Application
    Dim As Worksheet
    Dim As Range
    'set array sizes based on number of tasks in file
    SelectTaskColumn
    NumTsk = ActiveSelection.Tasks.Count
    ReDim TskID(NumTsk), TskNam(NumTsk), ResNam(NumTsk), SStart(NumTsk), SFinish(NumTsk)
    ReDim TskNot(NumTsk)
    MsgBox "This macro exports the following Project fields to Excel:" & vbCr & _
        "   Task ID" & vbCr & "   Task Name" & vbCr & _
        "   Resource Names" & vbCr & _
        "   Scheduled Start" & vbCr & "   Scheduled Finish" & vbCr & _
        "   Task Notes" & vbCr & vbCr & _
        "Note: only data for tasks in the current view will be exported", _
        vbInformation, "Export to Excel" & ver
    'First, gather desired data from Project in arrays
     
    Application.Caption = "Progress"
    ActiveWindow.Caption = " Gathering Project data into arrays"
    i = 1
    For Each In ActiveSelection.Tasks
        If Not Is Nothing Then
            TskID(i) = t.ID
            TskNam(i) = t.Name
            ResNam(i) = t.ResourceNames
            SStart(i) = t.ScheduledStart
            SFinish(i) = t.ScheduledFinish
            TskNot(i) = Replace(Trim(t.Notes), vbCr, vbLf)
            TskNot(i) = Replace(TskNot(i), vbVerticalTab, vbLf)
            TskNot(i) = Replace(TskNot(i), vbTab, vbLf)
            i = i + 1
        End If
    Next t
     
    'Second, set up existing instance of Excel, or if Excel is not running, start it
    On Error Resume Next
    Set Xl = GetObject(, "Excel.application")
    If Err <> 0 Then
        On Error GoTo 0
        Set Xl = CreateObject("Excel.Application")
        If Err <> 0 Then
            MsgBox "Excel application is not available on this workstation" _
                & vbCr & "Install Excel or check network connection", vbCritical, _
                "Notes Text Export - Fatal Error"
            FilterApply Name:="all tasks"
            Set Xl = Nothing
            On Error GoTo 0     'clear error function
            Exit Sub
        End If
    End If
    On Error GoTo 0
    Xl.Workbooks.Add
    BookNam = Xl.ActiveWorkbook.Name
          
    'Keep Excel in the background and minimized until export is done (speeds transfer)
    'NOTE: Items with a 'Reference annotation will not work without a reference to the Excel object library
    Xl.Visible = False
    Xl.ScreenUpdating = False
    Xl.DisplayAlerts = False
    ActiveWindow.Caption = " Writing data to worksheet"
    'Third, dump arrays into the Workbook
    Set s = Xl.Workbooks(BookNam).Worksheets(1)
    ActiveWindow.Caption = " do it again"
    s.Range("A1").Value = "ID"
    s.Range("B1").Value = "Task Name"
    s.Range("C1").Value = "Sched Start"
    s.Range("D1").Value = "Sched Finish"
    s.Range("E1").Value = "Res Names"
    s.Range("F1").Value = "Notes"
    Set c = s.Range("A2")
    RowIndex = 0
    For j = 1 To i - 1
        c.offset(RowIndex, 0).Value = TskID(j)
        c.offset(RowIndex, 1).Value = TskNam(j)
        c.offset(RowIndex, 2).Value = SStart(j)
        c.offset(RowIndex, 3).Value = SFinish(j)
        c.offset(RowIndex, 4).Value = ResNam(j)
        c.offset(RowIndex, 5).Value = TskNot(j)
        RowIndex = RowIndex + 1
    Next j
    'Fourth, format the Workbook
    s.Rows(1).Font.Bold = True
    s.Columns("A").AutoFit
    s.Columns("C:D").AutoFit
    s.Columns("C:D").NumberFormat = "m/d/yy;@"
    s.Columns("B").columnwidth = 25
    s.Columns("E").columnwidth = 25
    s.Columns("F").columnwidth = 80
    s.Range("B:B,E:F").WrapText = True
    s.Columns("A:F").VerticalAlignment = xlTop 'reference
    s.Range("C:D").HorizontalAlignment = xlLeft 'reference
    'Finally, close and exit
    MsgBox "Data Export is complete", vbOKOnly, "Notes Text Export"
    Application.Caption = ""
    ActiveWindow.Caption = ""
    Xl.Visible = True
    Xl.ScreenUpdating = True
    Set Xl = Nothing
    End Sub
    'This utility will print out the current object library references to the Immediate Window.
    Sub Chk_ObjLib_Refs()
    Dim oRef As Object
    For Each oRef In ThisProject.VBProject.References
        Debug.Print oRef.Description
        Debug.Print oRef.fullpath
    Next
    End Sub
    'This utility will find and remove all line feeds that may be present in the Notes field
    '   It will also report via the Immediate Window where it found the line feeds and how many
    Sub remove_LFs()
    Dim TstStr As String, NewStr As String
    Dim p1 As Integer, LFcntr As Integer
    Dim As Task
    For Each In ActiveProject.Tasks
        If Not Is Nothing Then
            If Len(t.Notes) > 0 Then
            Debug.Print "ID " & t.ID & " - " & Len(t.Notes) & " chars"
                NewStr = ""
                TstStr = t.Notes
                LFcntr = 0
                While InStr(1, TstStr, vbCr) > 0
                    LFcntr = LFcntr + 1
                    p1 = InStr(1, TstStr, vbCr)
                    NewStr = NewStr & Mid(TstStr, 1, p1 - 1)
                    TstStr = Mid(TstStr, p1 + 1)
                Wend
                t.Notes = NewStr & TstStr
                Debug.Print " found " & LFcntr & " line feeds"
                Debug.Print " ID now has " & Len(t.Notes) & " chars"
            End If
        End If
    Next t             
    End Sub

    Monday, June 15, 2020 9:21 AM

Answers

  • MiaAdrian,

    I'm glad you're using the "John code" but you didn't need to repeat it here.

    The simplest way is to edit this line of code

    TskID(i) = t.ID

    to

    TskID(i) = T.UniqueID

    The variable name in the code will of course no longer be accurate but that doesn't matter. But if you want to be pure, you'll have to find all instances of "TskID..." and replace with "TskUID..."

    You also should edit the code line for the Excel header to say:

    s.Range("A1").Value = "UID" or something similar.

    Hope this helps.

    John

    Monday, June 15, 2020 4:25 PM