none
Loop Through Files To Set Outline Level

    Pertanyaan

  • This VBA is from recording just two lines, opening the file and setting the outline level. The first chunk works. The second one doesn't even though it is identical except for the file name. This is just a test run for three files to check the outline command.

    I have to loop through 59 files, and still working on how to do that, and would appreciate any help with that too.

    Sub Macro8()
    ' Macro Macro8
    ' Macro Recorded 21/07/18 11:09 by Trevor.

    FileOpenEx Name:="X:\5000 Series Jobs\5142-177.mpp", FormatID:="MSProject.MPP"
    OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel1
    FileSave
    FileCloseEx

    FileOpenEx Name:="X:\5000 Series Jobs\5142-178.mpp", FormatID:="MSProject.MPP"
    OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel1p
    FileSave
    FileCloseEx

    FileOpenEx Name:="X:\5000 Series Jobs\5142-180.mpp", FormatID:="MSProject.MPP"
    OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel1p
    FileSave
    FileCloseEx

    21 Juli 2018 3:49

Semua Balasan

  • Hi Trevor,

    Welcome to vba!

    Don't know how it happened, but the letter "p" got appended to the OutlineShowTasks lines of your 2nd and 3rd try.  That causes the error.

    If your 59 filenames are indeed numerically incremented as shown, then looping through them may be as simple as something like this:

     
    Sub Macro2()
        On Error Resume Next 'This ignores errors like missing files etc.
        
        Dim Filename As String
        Dim Filenameseq As Long
        
        For Filenameseq = 177 To 240
            Filename = "X:\5000 Series Jobs\5142-" & Filenameseq & ".mpp"
            FileOpenEx Name:=Filename, FormatID:="MSProject.MPP"
            OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel1
            FileSave
            FileCloseEx
        Next Filenameseq
        
    End Sub

    21 Juli 2018 13:41
  • Tom, thanks for the reply.

    I ended up using this:

    Sub Loop_Files()
    ' Macro Loop_Files
    ' Macro 22/07/18 21:28 by Trevor Rabey.

    Dim FolderPath As String 'store the folderpath in memory.
    Dim FileName As String 'store the file name in memory.

    'error handling. If there is an error the macro will go to the bottom of the macro where the error name is
    'On Error GoTo ErrHandler

    'speed up macro.
    'True or False Allows or suppresses updating screen while macro runs.
    Application.ScreenUpdating = False
    'Prevents showing dialog boxes while macro runs.
    Application.DisplayAlerts = False

    'Call Dir the first time, pointing it to all Microsoft Project files in the folder path.
    FolderPath = "X:\PROJECTS\PLANNING\Perfect Project Planning\5000 Series Jobs\"

    'Check to make sure that the right most character is a backslash
    If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath + "\"

    FileName = Dir(FolderPath & "*.mpp")

    ' Loop until Dir returns an empty string.
    Do While FileName <> ""
    FileOpenEx Name:=FileName, FormatID:="MSProject.MPP"

    'Put whatever you wantto do here.

    OutlineShowTasks OutlineNumber:=pjTaskOutlineShowLevel1
    ProjectSummaryInfo StatusDate:="27/07/18 17:00"
    CalculateAll

    FileSave
    FileCloseEx

    ' Use Dir to get the next file name.
    FileName = Dir()
    'end of loop
    Loop

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    End Sub
    24 Juli 2018 1:52
  • Hi Trevor,

    Glad you got it sorted.  Dir() is a pretty powerful function that I'd (mostly) forgotten about since I'm usually wanting to pick a single file. It looks to be just the ticket for your issue.

    24 Juli 2018 13:14