Импортировать Excel в Microsoft Project - PullRequest
Новая
       56

Импортировать Excel в Microsoft Project

0 голосов
/ 19 июня 2020

Я хотел бы создать автоматизированный инструмент для импорта файла Excel для Microsoft Project. Я пытаюсь достичь этого в VBA (пожалуйста, предложите мне, если есть какие-либо другие варианты), и я исследовал некоторый код для настройки basi c.

Я нашел следующую ссылку для настройки системы и кода для этого автоматизация, но все еще не уверен, что приведенный ниже код точен или нет.

Источники:

https://www.linkedin.com/pulse/how-automate-ms-project-from-excel-app-malcolm-farrelle?trk=portfolio_article-card_title

Автоматизация создания n Microsoft Файлы проекта из файла excel с n строками

Я хотел бы написать сценарий обновления с использованием поля Mapping и создать / добавить как новые проекты.

Обновление

С помощью приведенного ниже ответа я переписал код для импорта нескольких файлов и сохранил его как файл * .mpp.

, но проблема в том, что файл mpp открывается и это должно произойти в серверной части, пользователь не должен ничего просматривать.

Код: 

Private Sub ImportButton_Click()
    On Error GoTo Exception
        
    Dim InputFolderPath As String, DefaultInputFolderPath As String, DefaultOutputFolderPath  As String
    Dim fileExplorer As FileDialog
    
    InputFolderPath = ""
    DefaultInputFolderPath = "D:\Sample Projects\MPP Import\Input\"
    DefaultOutputFolderPath = "D:\Sample Projects\MPP Import\Output\"
    Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
    
     'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False
    If fileExplorer.Show = -1 Then 'Any folder is selected
        InputFolderPath = fileExplorer.SelectedItems.Item(1) & "\"
    Else
        InputFolderPath = DefaultInputFolderPath
    End If
       
    Call CreateProjectFromExcelFile(InputFolderPath, DefaultOutputFolderPath)
    
Exception:
    Select Case err.Number   ' Evaluate error number.
        Case 0
            Exit Sub
        Case Else
            MsgBox "UNKNOWN ERROR  - Error# " & err.Number & " : " & err.Description
    End Select
    Exit Sub
ExitCode:
    Exit Sub
End Sub

Public Sub CreateProjectFromExcelFile(InputFolderPath As String, DefaultOutputFolderPath As String)

    Dim myFile As String, myExtension As String, oFullFilename As String, oFilename As String
  

    ' get access to Project application object
    Dim appMSP As MSProject.Application
    On Error Resume Next
    ' see if the application is already open
    Set appMSP = GetObject(, "MSProject.Application")
    If err.Number <> 0 Then
        ' wasn't open, so open it
        Set appMSP = CreateObject("MSProject.Application")
    End If
    ' return to whatever error handling you had
    On Error GoTo 0
    
    appMSP.Visible = False
      
    MapEdit Name:="ImportMap", Create:=True, OverwriteExisting:=True, DataCategory:=0, CategoryEnabled:=True, TableName:="Data", FieldName:="Name", ExternalFieldName:="Task_Name", ExportFilter:="All Tasks", ImportMethod:=0, HeaderRow:=True, AssignmentData:=False, TextDelimiter:=Chr$(9), TextFileOrigin:=0, UseHtmlTemplate:=False, IncludeImage:=False
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Duration", ExternalFieldName:="Duration"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Start", ExternalFieldName:="Start_Date"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Finish", ExternalFieldName:="End_Date"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Resource Names", ExternalFieldName:="Resource_Name"
    MapEdit Name:="ImportMap", DataCategory:=0, FieldName:="Notes", ExternalFieldName:="Remarks"
    ' open the Excel file to import
    Dim strFilepath As String
    'Target File Extension (must include wildcard "*")
    myExtension = "*.xlsx"

    'Target Path with Ending Extention
    myFile = Dir(InputFolderPath & myExtension)
            
            'Loop through each Excel file in folder
    While myFile <> ""
        If (myFile = "") Then
            MsgBox ("No files avaalable!")
            GoTo ExitCode
        End If
        
        'This example will print the file name to the immediate window
         strFilepath = InputFolderPath & myFile
         
         oFullFilename = Right(strFilepath, Len(strFilepath) - InStrRev(strFilepath, "\"))
         oFilename = Left(oFullFilename, (InStr(oFullFilename, ".") - 1))
         
         appMSP.Visible = False
         
         appMSP.FileOpenEx Name:=strFilepath, ReadOnly:=False, Merge:=1, FormatID:="MSProject.ACE", Map:="ImportMap"
         appMSP.FileSaveAs Name:=DefaultOutputFolderPath & oFilename & ".mpp"
        'Set the fileName to the next file
         myFile = Dir
    Wend
    appMSP.FileCloseAllEx pjDoNotSave
    Set appMSP = Nothing
    MsgBox ("Imported Successfully...")
ExitCode:
    Exit Sub
End Sub

1 Ответ

1 голос
/ 21 июня 2020

Я хотел бы создать автоматизированный инструмент для импорта файла Excel для Microsoft Project.

Автоматизировать создание нового файла Microsoft Project из файла Excel очень просто - это всего лишь один команда: FileOpenEx .

Вот как это можно сделать из Excel: 

Sub CreateProjectFromExcelFile()

    ' get access to Project application object
    Dim appMSP As MSProject.Application
    On Error Resume Next
    ' see if the application is already open
    Set appMSP = GetObject(, "MSProject.Application")
    If Err.Number <> 0 Then
        ' wasn't open, so open it
        Set appMSP = CreateObject("MSProject.Application")
    End If
    ' return to whatever error handling you had
    On Error GoTo 0
    
    appMSP.Visible = True
    
    ' open the Excel file to import
    appMSP.FileOpenEx Name:="C:\<your path here>\SampleNewProjectForImport.xlsx" _
        , Map:="<your map name here>"
    
    appMSP.FileSaveAs Name:="MyProject.mpp"
    
End Sub

Обновите пути / имена в строке FileOpenEx вашими именами, добавьте ошибку обработки и другого кода по своему усмотрению, и добавьте ссылку на библиотеку объектов проекта.

Примечание. Если вы не знаете, как работает импорт в MS Project, см. Импорт данных Excel в Project для объяснения того, как работает этот процесс.

Примечание 2: та же команда используется для добавления или обновления существующего расписания.

...