Jak przez makro zapisać plik MS Project 2000 na serwerze?

Problem

Analizując stan Portfela Projektów potrzebowałem informacji syntetycznych z harmonogramów, które były wysyłane przez Kierowników Projektów emailem (plik mpp), później zrzucane przez odbiorcę do jednego katalogu, przeglądane i generowane z nich ręcznie mapy Excela (plik xls) do dalszej analizy za pomocą skryptów php w raporcie zbiorczym (wykresy wartości wypracowanej/earned value).

  • Jak wykorzystać Visual Basic/VB w MS Project/MSP, aby wyeliminować pośrednictwo emaila i ręcznej pracy do zapisania plików na serwerze?
  • Jak zalogować się do katalogu sieciowego w Visual Basic/VB?
  • Jak zautoryzować się do katalogu sieciowego przez Visual Basic/VB?
  • Jak zapisać plik w katalogu sieciowym/na serwerze w Visual Basic/VB?

Rozwiązanie

Wystarczy dodać poniższe makro do MS Project i podpiąć je pod jakiś przycisk na pasku (warto jeszcze zabezpieczyć hasłem przed zmianami). Użytkownicy klikając w przycisk, zapisują go na serwerze w katalogu, do którego skrypt się automatycznie loguje (logowanie do katalogu sieciowego przez Visual Basic/VB).

Makro MS Project 2000

Makro MS Project 2000

Poniższe makro również generuje plik Excela, dla późniejszych analiz w php aktualności i poprawności raportowanego harmonogramu. Osobiście zrobiłem tak, że makro wraz z mapą Excela do eksportu jest zapisane w pliku GLOBAL.MPT, który każdy użytkownik jednorazowo nadpisuje na swój obecny.

Makro do pobrania: MSP_save_to_server.tar

'**************************************************
'Wykonane przez Krzysztof Przygoda, v1.0 2011-03-14
'**************************************************
'Makro zapisuje:
'1) harmonogram w formacie mpp (MSProject 2000-2003)
'2) i xls (na podstawie mapy !projekty.domena.pl w pliku GLOBAL.MPT)
'do folderu sieciowego na serwerze http://projekty.domena.pl/public
'Gdy w tytule harmonogramu nie ma numeru projektu, użytkownik jest proszony o jego podanie, a tytuł poprawiany.
'Gdy katalog nie jest osiągalny, zapisywane są pliki lokalne, aby je załadować ręcznie na serwer www.
'**************************************************

'Special Chars constants help:
' Constant Definition
' -----------------------------------------------
' vbBack A backspace character [Chr(8)]
' vbCr A carriage return [Chr(13)]
' vbCrLf A carriage return and line feed [Chr(13) + Chr(10)]
' vbLf A linefeed [Chr(10)]
' vbNewLine A platform-specific new line character, either [Chr(13) + Chr(10)] or [Chr(13)]
' vbNullChar A null character of value 0 [Chr(0)]
' vbNullString A string of value 0 [no Chr code]; note that this is not the same as ""
' vbTab A tab character [Chr(9)]

'**************************************************
'Komunikaty:
Const MSG_NO_TASKS = "W bieżącym harmonogramie Projektu nie ma zadań. Spróbuj ponownie, gdy harmonogram będzie zawierał zadania."
Const MSG_NOFILEOPEN = "Nie otworzono żadnego harmonogramu Projektu. Otwórz harmonogram Projektu i uruchom to makro ponownie."
Const MSG_PROJNUM_MSG = "Wprowadź numer Projektu, np.: 297" & vbNewLine & vbNewLine & "INFO: Numer Projektu jest NUMEREM decyzji Komitetu Sterującego Portfela Projektów o jego uruchomieniu (patrz decyzja KS nr NUMER[/ROK])."
Const MSG_NOAUTH = "Nie mam kontaktu z serwerem projekty.domena.pl!" & vbNewLine & vbNewLine & "INFO: Nie zapiszesz plików, jeśli korzystasz w tej chwili z VPN. Natomiast, jeśli jesteś w sieci firmowej, zgłoś ten problem Administratorowi (tel. 1165) lub na email: infoprojekt@domena.pl"
Const MSG_FILE_OK = "Zapisano pomyślnie na serwerze projekty.domena.pl!" & vbNewLine & vbNewLine & "Co dalej?" & vbNewLine & "1) Teraz możesz zapisać kopię dla siebie na dysku lokalnym do przyszłych edycji," & vbNewLine & "2) a następnie dokończ raport na stronie http://projekty.domena.pl"
Const MSG_FILE_ERROR = "Nie można było zapisać plików na serwerze projekty.domena.pl!" & vbNewLine & vbNewLine & "Co dalej?" & vbNewLine & "Zapiszę teraz 2 pliki mpp i xls na Twoim dysku, a Ty następnie załaduj je ręcznie do raportu na stronie http://projekty.domena.pl"
Option Compare Text

'**************************************************
'Dane katalogu sieciowego, w którym mają być zapisane pliki harmonogramu:
Const NET_PATH = "\\10.1.1.206\katalog"
Const NET_USER = "twoja nazwa użytkownika"
Const NET_PASSWD = "twoje hasło do folderu sieciowego"

‚**************************************************
‚Formaty plików:
Const FILE_MPP_FORMATID = „MSProject.MPP.9” ‚MS Project 2000-2003 dla wyższych wersji niż 2003
Const FILE_XLS_FORMATID = „MSProject.XLS5” ‚MS Excel 2000

‚**************************************************
‚Procedura główna
‚**************************************************
Sub Raportuj()
‚Sprawdź czy jest wogóle otwarty jakiś plik harmonogramu
checkIfProjectOpen

‚Jeżeli harmonogram jest pusty, wyświetl alert i zakończ wykonywanie makra
If ActiveProject.Tasks.Count = 0 Then
MsgBox MSG_NO_TASKS, Buttons:=vbCritical + R_TO_L, Title:=Application.Name
End
End If

‚Zaloguj się w międzyczasie do folderu serwera
authResult = authNetFolder()

Dim projectServerFile, projectServerFileName As String
Dim projectName, projectTitle, projectNumber As String
Dim projectLocalFile As String
Dim projectLocalFilePath As String

ActiveProject.DisplayProjectSummaryTask = True

projectLocalFile = Split(ActiveProject.FullName, „.mpp”)(0) ‚nazwa otwartego pliku bez rozszerzenia
projectLocalFilePath = ActiveProject.Path ‚ścieżka do otwartego pliku
projectName = ActiveProject.Name ‚nazwa pliku – to samo co projectLocalFile
projectTitle = ActiveProject.Title ‚tytuł harmonogramu lub inaczej nazwa summary project task
projectNumber = getProjectNumber()

projectServerFileName = projectNumber ‚na serwerze zapisujemy tylko z nazwą numer.ext
projectServerFile = NET_PATH & „\” & projectServerFileName

On Error GoTo NetFileError:
‚Zapisz pliki na serwerze
FileSaveAs Name:=projectServerFile, FormatID:=FILE_MPP_FORMATID
FileSaveAs Name:=projectServerFile, FormatID:=FILE_XLS_FORMATID, map:=”!projekty.domena.pl”
‚Pogratuluj, gdy OK
MsgBox MSG_FILE_OK, vbInformation, Title:=Application.Name
‚Przywróć oryginalną nazwę pliku
ActiveProject.Name = projectName
‚Zapisz jeszcze plik lokalnie pod wybraną przez użytkownika nazwą
SaveLocalFile
Exit Sub ‚Koniec makra

NetFileError:
MsgBox MSG_FILE_ERROR, vbExclamation + R_TO_L, Title:=Application.Name
SaveLocalFile projectLocalFile, True
Exit Sub ‚Koniec makra
End Sub

‚**************************************************
Sub SaveLocalFile(Optional Name As String, Optional XLS As Boolean)
On Error GoTo LocalFileError:
If Name <> „” Then
FileSaveAs Name:=Name, FormatID:=”MSProject.MPP” ‚Zostawiamy wersję oryginalną MSP
If XLS Then FileSaveAs Name:=Name, FormatID:=FILE_XLS_FORMATID, map:=”!projekty.domena.pl”
Else
FileSaveAs FormatID:=”MSProject.MPP” ‚Zostawiamy wersję oryginalną MSP
If XLS Then FileSaveAs FormatID:=FILE_XLS_FORMATID, map:=”!projekty.domena.pl”
End If
Exit Sub

LocalFileError:
End ‚Kończy działanie makra
End Sub

‚**************************************************
Private Function getProjectNumber() As String
Dim result, projectTitle As String
Dim projectTitleArray As Variant

projectTitle = ActiveProject.Title
projectTitleArray = Array(„”)

‚If InStr(1, ActiveProject.Title, „.”) Then
‚If (projectTitle Like „#*.*”) Then
If RegEx(projectTitle, „^[0-9]+[.]”) Then
projectTitleArray = Split(ActiveProject.Title, „.”)
projectTitle = projectTitleArray(1)
End If

result = projectTitleArray(0)

If Not IsNumeric(result) Then
result = InputBox(Prompt:=MSG_PROJNUM_MSG)
End If

If result = „” Then
‚Cancel pressed
End
ElseIf IsNumeric(result) Then
‚Popraw przy okazji nazwę projektu na schemat numer.nazwa
ActiveProject.Title = result & „.” & projectTitle
getProjectNumber = result
Else
‚Jeśli nie jest to liczba, poproś jeszcze raz
getProjectNumber = getProjectNumber()
End If
End Function

‚**************************************************
Private Function authNetFolder() As Double
‚Funkcja loguje do katalogu sieciowego
‚Rozwiązanie pochodzi z: http://www.vbforums.com/showthread.php?t=540383
‚Shell („Net Use \\IPADDRESS\Share /user:UsernameHere PasswordHere”, vbHide)
shellCommand = „Net Use ” & NET_PATH & ” /user:” & NET_USER & ” ” & NET_PASSWD
On Error GoTo NoAuth:
authFolder = Shell(shellCommand, vbHide)
Exit Function

NoAuth:
MsgBox MSG_NOAUTH, vbExclamation + R_TO_L, Title:=Application.Name
Exit Function
End Function

‚**************************************************
Private Sub checkIfProjectOpen()
‚Procedura sprawdza, czy otworzono plik projektu

Dim strName As String

On Error GoTo NoFileOpen:
strName = ActiveProject.Name
Exit Sub

NoFileOpen:
MsgBox MSG_NOFILEOPEN, vbExclamation + R_TO_L, Title:=Application.Name
End ‚Kończy działanie makra

End Sub

‚**************************************************
Function RegEx(strTest As String, strPattern As String) As Boolean
‚Online tester: http://www.regular-expressions.info/vbscriptexample.html
‚HowTo: http://www.zytrax.com/tech/web/regex.htm

Dim RegExpr As Object

Set RegExpr = CreateObject(„VBScript.RegExp”)
RegExpr.Pattern = strPattern
RegEx = RegExpr.test(strTest)
‚Dim Matches As Object
‚Set Matches = RegEx.Execute(strTest)
‚strMatch = CStr(Matches(0))
Set RegExpr = Nothing
End Function

‚**************************************************
‚Procedura obecnie nieużywana, ponieważ korzystamy z mapy Excela zrobionej ręcznie w GLOBAL.MPT
Sub MakeEntryTableMap()

MapEdit Name:=”Fields in the Gantt Chart View”, Create:=True, OverwriteExisting:=True, _
DataCategory:=pjMapTasks, CategoryEnabled:=True, TableName:=”Task_Table”, _
FieldName:=”ID”, ExternalFieldName:=”ID”
MapEdit Name:=”Fields in the Gantt Chart View”, DataCategory:=pjMapTasks, _
FieldName:=”Name”, ExternalFieldName:=”Tasks”
MapEdit Name:=”Fields in the Gantt Chart View”, DataCategory:=pjMapTasks, _
FieldName:=”Duration”
MapEdit Name:=”Fields in the Gantt Chart View”, DataCategory:=pjMapTasks, _
FieldName:=”Start”, ExternalFieldName:=”Start_Date”
MapEdit Name:=”Fields in the Gantt Chart View”, DataCategory:=pjMapTasks, _
FieldName:=”Finish”, ExternalFieldName:=”Finish_Date”
MapEdit Name:=”Fields in the Gantt Chart View”, DataCategory:=pjMapTasks, _
FieldName:=”Predecessors”
MapEdit Name:=”Fields in the Gantt Chart View”, DataCategory:=pjMapTasks, _
FieldName:=”Resource Names”, ExternalFieldName:=”Resources”

End Sub

 

Dyskusja

Wypowiedz się