Read From Excel Sheet & Bulk Update Enterprise Resource Pool Values Using Macro

Bulk Update Enterprise Resource Pool resource properties using macro, read data from excel sheet and update in ERP

* Add reference to Microsoft. Excel. Application
* There has to be a common identifier between excel sheet column and ERP for matching purpose

Sub ReadResourceValueFromExcelAndUpdateResourceGlobal() 
'Declare strings / integers to be used in procedures
Dim MatchValue, ProjectServerResourceName As String
Dim xlResource As Integer

'Declare Object Variables for use
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

'Set Excel Application, Workbook, Worksheet reference to be used
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Open("C:\Users\sunilsingh\ResouceList.xlsx", False, True)
Set xlSheet = xlBook.Worksheets(1)

'Declare and Set Resource to be used from current Global Resource Sheet
Dim res As Resources
Set res = ActiveProject.Resources
Dim r As Resource

'Loop thorugh Excel Sheet get values and find in Global Resource Sheet and do the operation

For xlResource = 1 To 100 'no of resources in xl sheet or you can use Sheet.row count

 MatchValue = xlSheet.Cells(xlResource, 3).Value
 ProjectServerResourceName = xlSheet.Cells(xlResource, 2).Value
 If MatchValue <> "" Then
 For Each r In res

 If LCase(r.WindowsUserAccount) = LCase(MatchValue) Then
 x = MsgBox("Match Found" + vbCrLf + vbCrLf + r.WindowsUserAccount + vbCrLf + r.Name, vbInformation)
 ' Update Resource properties / values in Resource Global
 r.Name = "Sunil US Account" 'ProjectServerResourceName
 r.RBS = "xxx/xxx/xxxxx/xxxxx" ' note the separator char use as you have set in your CF
 r.HyperlinkAddress = "https://Servernaem/person.aspx?accountname=sunilsingh"
 x = MsgBox("Resource Data Updated" + vbCrLf + vbCrLf + r.WindowsUserAccount + vbCrLf + r.Name, vbInformation)
 End If
 Next r
 End If
Next xlResource

' Clear Memory / Clean Up
Set xlSheet = Nothing
xlBook.Close
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing

End Sub

Advertisements