Consulting

Results 1 to 3 of 3

Thread: MS Project VBA help- Open MS Project Files

  1. #1
    VBAX Regular
    Joined
    Jan 2008
    Posts
    8
    Location

    Wink MS Project VBA help- Open MS Project Files

    I need some urgent help. I need VBA code where when run in Micosoft Project it looks through directory on C: and opens up ms project files adds a task called "Print Financials" and closes the project

    There are 100's ms project files and to do this manually is time consuming process. Can anyone help

    Need some kind of loop going to look through the C: Folder for mpp files and opening them one by one and adding task

    Any ideas ??????????????????????

    Great help guys

  2. #2
    VBAX Regular
    Joined
    Jan 2008
    Posts
    8
    Location
    I have managed to create an open dialogue box which allows user to search for msp files from diff folders. When users selects multiple files and clicks open the files are stored and user has option to search for more files in diff folder. When user is ready to open files the user clicks cancel and the files will open. The code def works for excel files but I have changed it to relate to MS Project.

    The code below gives does not support Arguement error !!!!!!!!!!

    Im stumbled and need advise


    Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
    ' Loop through the directory specified in strDirPath and save each
    ' file name in an array, then return that array to the calling
    ' procedure.
    ' Return False if strDirPath is not a valid directory.
    Dim strTempName As String
    Dim varFiles() As Variant
    Dim lngFileCount As Long

    On Error GoTo GetAllFiles_Err

    ' Make sure that strDirPath ends with a "\" character.
    If Right$(strDirPath, 1) <> "\" Then
    strDirPath = strDirPath & "\"
    End If

    ' Make sure strDirPath is a directory.
    If GetAttr(strDirPath) = vbDirectory Then
    strTempName = Dir(strDirPath, vbDirectory)
    Do Until Len(strTempName) = 0
    ' Exclude ".", "..".
    If (strTempName <> ".") And (strTempName <> "..") Then
    ' Make sure we do not have a sub-directory name.
    If (GetAttr(strDirPath & strTempName) _
    And vbDirectory) <> vbDirectory Then
    ' Increase the size of the array
    ' to accommodate the found filename
    ' and add the filename to the array.
    ReDim Preserve varFiles(lngFileCount)
    varFiles(lngFileCount) = strTempName
    lngFileCount = lngFileCount + 1
    End If
    End If
    ' Use the Dir function to find the next filename.
    strTempName = Dir()
    Loop
    ' Return the array of found files.
    GetAllFilesInDir = varFiles
    End If
    GetAllFiles_End:
    Exit Function
    GetAllFiles_Err:
    GetAllFilesInDir = False
    Resume GetAllFiles_End
    End Function
    Public Function GetFiles() As Variant
    Dim fn As Variant, f As Integer, fn2() As Variant

    'Display Open Files dialogue
    fn = Application.GetOpenFilename("Microsoft Project Files,*.mpp", 1, "Select One Or More Files To Open", , True)
    'fn = Application.GetOpenFilename("Microsoft Project Files (*.mpp), *.mpp")
    'If the dialogue is cancelled it will be FALSE (ie. a boolean value)
    If IsEmpty(fn) Then Exit Function
    If Not IsArray(fn) Then If fn = False Then Exit Function

    'File open dialogue gives is an array starting from 1 to x but we want it starting from 0 so ...
    ' ... we need a new array starting from 0
    ReDim fn2(UBound(fn) - 1)

    'Loop for the number of elements in fn
    For f = 1 To UBound(fn)

    'Copy element 1 of fn to element 0 of fn2, element 2 to element 1, etc.
    fn2(f - 1) = fn(f)

    Next f

    'Return the files selected in a base 0 array
    GetFiles = fn2
    End Function
    Public Function GetFileSelections()
    Dim fn As Variant, fn2() As Variant, f As Integer

    ReDim fn2(0)

    Do

    fn = GetFiles

    If Not IsEmpty(fn) Then

    ReDim Preserve fn2(UBound(fn2) + (UBound(fn) + IIf(UBound(fn2) = 0, 0, 1)))

    For f = 0 To UBound(fn)

    fn2((UBound(fn2) - UBound(fn)) + f) = fn(f)

    Next f

    End If

    Loop Until IsEmpty(fn)

    GetFileSelections = fn2
    End Function
    ' Automation of importing Quality Audit Sheets into Report

    Sub Open_Files_MSP()
    Dim intPosition As Integer
    Dim FilePath As String
    Dim FileNames() As Variant
    ' Var to check first three chars
    Dim CheckFile As String
    Dim FileCharCheck As String
    Dim fileName As String

    ' Put your files in this list... run a function to create this array by
    'telling the function where to look for the files.
    FileNames = GetFileSelections
    Dim prjApp As Object
    Dim prjDoc As Object
    Set prjApp = CreateObject("MSProject.Application")

    ' This is the loop....
    For intPosition = LBound(FileNames) To UBound(FileNames)
    fileName = FileNames(intPosition)
    ' Open up the file that you want to use
    Set prjDoc = prjApp.FileOpen(FileNames(intPosition))
    prjApp.Visible = True

    Next
    End Sub

  3. #3
    Quote Originally Posted by raeraz
    I need some urgent help. I need VBA code where when run in Micosoft Project it looks through directory on C: and opens up ms project files adds a task called "Print Financials" and closes the project

    There are 100's ms project files and to do this manually is time consuming process. Can anyone help

    Need some kind of loop going to look through the C: Folder for mpp files and opening them one by one and adding task

    Any ideas ??????????????????????

    Great help guys
    Do you really want to add the task to every Project File you find? You can use the FilePicker dialogue box offered by XL (why it is not available to Project I don't understand) by defining an XL application object and then using its filepicker method (Away from MS apps right now, load XL vba help and look for "File Dialogue Picker" or some such . . you may specify multifile select which should suit your needs.

    If you really want to search C:\ for all project files use the DIR command . . .would be a good case for a recursive function to traverse the folder structure.

    Mal

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •