Printable View
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
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
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.Quote:
Originally Posted by raeraz
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