'#Reference {F64FEA84-AF63-11D0-81CE-444553540000}#1.0#0#D:\Program Files\Success Estimator\SuccessDB.dll#US Cost SuccessDB Object Library v1.0
'#Reference {9083D777-A98F-11CE-92DE-444553540000}#1.0#0#D:\Program Files\Success Estimator\success.tlb#US Cost Success Interface v1.0
' Success Objects
Dim oSuccessApp As Application
Dim oDocument As Document
Dim oProject As Project
Dim oTreeLevel As TreeLevel
Dim oLevels As Levels
Dim oDIA As DetailItemAssignment
Dim oDIAs As DetailItemAssignments
Dim oDetailItem As DetailItem
Dim oDetailItems As DetailItems

' Excel Objects
Dim oXL As Object
Dim oWS As Object
Dim oWB As Object

Dim ListArrayPriceSource$()
Dim ListArrayWorksheets$()
Dim ListArrayCostTargetField$()

Dim RemoveExisting As Boolean
Dim WorksheetIndex As Integer
Dim CloseOnFinish As Boolean
Dim CostTargetFieldSelectedIndex As Integer

Dim SourceFilePath As String
Dim SelectedTreeLevel As String

' Column Indexes from source
Dim SourceQuantity As Integer
Dim SourceName As Integer
Dim SourceDescription As Integer
Dim SourcePrice As Integer
Dim SourceUOM As Integer

Dim SuccessVersion As Long

Sub Main

Dim iButton%

On Error GoTo ErrHandler

	Set oSuccessApp = CreateObject("Success.Application.1")
	If oSuccessApp Is Nothing Then GoTo e_Errhandler

	Set oDocument = oSuccessApp.ActiveDocument
	If oDocument Is Nothing Then GoTo e_Errhandler

	Set oProject = oDocument.Project
	If oProject Is Nothing Then GoTo e_ErrHandler

	SuccessVersion = GetVersion(oSuccessApp)

	GetDefaultValues
	PopulateListArrays

ShowDialog:

	Begin Dialog UserDialog 700,203,"PlanSwift Import",.DialogFunc ' %GRID:10,7,1,1
		Text 10,18,120,14,"PlanSwift File :",.Text2
		TextBox 130,14,510,21,.SourceFilePath
		DropListBox 130,42,260,70,ListArrayWorksheets(),.Worksheet
		OKButton 490,161,90,21,.OK
		DropListBox 130,70,260,91,ListArrayCostTargetField(),.CostTargetField
		CancelButton 590,161,90,21,.Cancel
		CheckBox 10,105,280,14,"Remove existing items prior to importing",.RemoveExisting
		GroupBox 0,182,710,21,"",.GroupBox1
		Text 0,189,710,14,"Ready",.Status
		PushButton 650,14,30,21,"...",.Browse
		Text 10,46,110,14,"Worksheet :",.Text7
		CheckBox 10,126,210,14,"Close after successful import",.CloseOnFinish
		Text 10,74,110,14,"Import Cost To :",.Text8

	End Dialog


	Dim dlg As UserDialog

	iButton = Dialog(dlg)

	SetDefaultValues

e_ErrHandler:

	Set oDetailItem = Nothing
	Set oDetailItems = Nothing
	Set oDIA = Nothing
	Set oDIAs = Nothing
	Set oTreeLevel = Nothing
	Set oLevels = Nothing
	If Not oProject Is Nothing Then
		If oProject.IsOpened Then oProject.Close
		Set oProject  = Nothing
	End If
	Set oDocument = Nothing
	Set oSuccessApp = Nothing

	Exit Sub

ErrHandler:
	MsgBox "[" & Err.Number & "] " &  Err.Description, vbExclamation, "Error"
	GoTo e_Errhandler

End Sub
Sub GetDefaultValues

	SourceFilePath = GetSetting("Success Estimator PlanSwift Import", "Settings", "SourceFilePath","")
	WorksheetIndex = GetSetting("Success Estimator PlanSwift Import", "Settings", "Worksheet","1")
	RemoveExisting = CBool(GetSetting("Success Estimator PlanSwift Import", "Settings", "RemoveExisting","False"))
	CloseOnFinish = CBool(GetSetting("Success Estimator PlanSwift Import", "Settings", "CloseOnFinish","False"))
	CostTargetFieldSelectedIndex = CInt(GetSetting("Success Estimator PlanSwift Import", "Settings", "CostTargetField","0"))

	' Reset if the file does not exist in the path
	If Len(Dir(SourceFilePath)) = 0 Then SourceFilePath = ""

End Sub
Sub SetDefaultValues

	SaveSetting "Success Estimator PlanSwift Import", "Settings", "SourceFilePath", SourceFilePath
	SaveSetting "Success Estimator PlanSwift Import", "Settings", "RemoveExisting", RemoveExisting
	SaveSetting "Success Estimator PlanSwift Import", "Settings", "Worksheet", WorksheetIndex
	SaveSetting "Success Estimator PlanSwift Import", "Settings", "CloseOnFinish", CloseOnFinish
	SaveSetting "Success Estimator PlanSwift Import", "Settings", "CostTargetField", CostTargetFieldSelectedIndex

End Sub
Sub LoadControlValues

	DlgValue("RemoveExisting", RemoveExisting)
	DlgText("SourceFilePath", SourceFilePath)
	DlgValue("CloseOnFinish", CloseOnFinish)
	DlgValue("CostTargetField", CostTargetFieldSelectedIndex)

	DlgEnable("SourceFilePath",False)

	LoadWorksheetList SourceFilePath, WorksheetIndex

End Sub
Private Function LoadWorksheetList(FilePath As String, Optional SelectedIndex As Integer) As Boolean
Dim i As Integer

	On Error GoTo ErrHandler

	If Len(Dir(FilePath)) = 0 Then Exit Function

	Erase ListArrayWorksheets
	Set oXL = CreateExcel

	If Not oXL Is Nothing Then
		Set oWB = OpenWorkbook(oXL, FilePath)
		If oWB Is Nothing Then GoTo e_ErrHandler
		For i = 1 To oWB.worksheets.Count
			ReDim Preserve ListArrayWorksheets$(i-1)
			ListArrayWorksheets$(i-1) = oWB.worksheets(i).Name
		Next i
	End If

	DlgListBoxArray "Worksheet", ListArrayWorksheets
	DlgValue "Worksheet", SelectedIndex

	LoadWorksheetList = True

e_ErrHandler:

	Set oWB = Nothing
	CloseExcel oXL

	Exit Function

ErrHandler:

	LoadWorksheetList = False
	MsgBox "Error in LoadWorksheetList function." & vbCrLf & vbCrLf & "[" & Err.Number & "] " & Err.Description, vbExclamation, "Error"
	GoTo e_ErrHandler

End Function
Private Function OpenWorkbook(XL As Object, FilePath As String) As Object

On Error GoTo ErrHandler

	If Not XL Is Nothing Then
		Set OpenWorkbook = XL.workbooks.Open (FilePath, False)
	End If

e_ErrHandler:

	Exit Function

ErrHandler:

	Set OpenWorkbook = Nothing
	MsgBox "Error in OpenWorkbook function." & vbCrLf & vbCrLf & "[" & Err.Number & "] " & Err.Description, vbExclamation, "Error"
	GoTo e_ErrHandler

End Function

Private Function CreateExcel() As Object

	On Error GoTo ErrHandler

		Set CreateExcel = CreateObject("Excel.Application")
		CreateExcel.displayalerts = False
		Exit Function

	ErrHandler:
		CreateExcel = Nothing

End Function
Private Function CloseExcel(XL As Object) As Boolean

	If Not XL Is Nothing Then
		XL.Quit
		Set XL = Nothing
	End If

End Function

Sub PopulateListArrays

	ReDim ListArrayCostTargetField$(7)

	ListArrayCostTargetField(0) = "<Do Not Import>"
	ListArrayCostTargetField(1) = "Labor"
	ListArrayCostTargetField(2) = "Equipment"
	ListArrayCostTargetField(3) = "Material"
	ListArrayCostTargetField(4) = "Other1"
	ListArrayCostTargetField(5) = "Other2"
	ListArrayCostTargetField(6) = "Other3"

End Sub

Rem See DialogFunc help topic for more information.
Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean
Dim BrowsePath As String

	Select Case Action%

		Case 1 ' Dialog box initialization
			LoadControlValues

			RemoveExisting  = DlgValue("RemoveExisting") = 1
			SourceFilePath = DlgText("SourceFilePath")

		Case 2 ' Value changing or button pressed
			Rem DialogFunc = True ' Prevent button press from closing the dialog box
			Select Case DlgItem

				Case "RemoveExisting
					RemoveExisting  = DlgValue("RemoveExisting") = 1

				Case "CloseOnFinish"
					CloseOnFinish = DlgValue("CloseOnFinish") = 1

				Case "Browse"
					BrowsePath = GetFilePath$(, "xls", , "Open PlanSwift Export File", 0)
					If BrowsePath <> "" Then
						DlgText "SourceFilePath", BrowsePath
						SourceFilePath = BrowsePath
						LoadWorksheetList SourceFilePath, 0
					End If
					DialogFunc = True 'do not exit the dialog

				Case "Worksheet"
					WorksheetIndex = DlgValue("Worksheet")

				Case "CostTargetField"
					CostTargetFieldSelectedIndex = DlgValue("CostTargetField")

				Case "OK"
					DlgEnable "Cancel", False
					DlgEnable "OK", False

					If Process Then
						MsgBox "Import complete.", vbInformation, "Status"
					End If

					DlgEnable "OK", True
					DlgEnable "Cancel", True

					DialogFunc = Not CloseOnFinish ' only exit if option is selected

				Case "Cancel"
					' Save Settings
					SetDefaultValues

			End Select

		Case 3 ' TextBox or ComboBox text changed

			Select Case DlgItem

				Case "SourceFilePath"


			End Select

		Case 4 ' Focus changed

		Case 5 ' Idle
			Rem Wait .1 : DialogFunc = True ' Continue getting idle actions

		Case 6 ' Function key

	End Select

End Function
Private Function OpenSource() As Boolean
Dim iMsg As Integer

	On Error GoTo ErrHandler

	' Make sure the file exists
	If Len(Dir(SourceFilePath)) = 0 Then
		MsgBox "Source file not found in specified path.", vbExclamation, "Error"
		GoTo e_ErrHandler
	End If

	' Validate the contents of the file
	SetStatus "Accessing source file..."

	Set oWB = OpenWorkbook(oXL, SourceFilePath)
	Set oWS = oWB.Worksheets(WorksheetIndex+1)

	OpenSource = True

e_ErrHandler:

	Exit Function

ErrHandler:

	MsgBox "Error in OpenSource function." & vbCrLf & vbCrLf & "[" & Err.Number & "] " & Err.Description, vbExclamation, "Error"
	OpenSource = False
	GoTo e_ErrHandler

End Function
Private Function ValidImportFile(WS As Object) As Boolean

	If Not WS Is Nothing Then
		ValidImportFile =  UCase(Replace(Trim(oWS.cells(1,1))," ", "")) = "TRASERVERSION"
	Else
		ValidImportFile = False
	End If

End Function
Private Sub SetStatus(Status As String)

	DlgText "Status", Status

End Sub

Private Function Process() As Boolean
Dim lRow As Long
Dim lRows As Long
Dim lRowDetail As Long
Dim lRowsDetail As Long
Dim iColumn As Integer
Dim iColumns As Integer
Dim HaveColumnSequence As Boolean
Dim IsListNameRow As Boolean
Dim ListCount As Integer
Dim ColumnHeader As String
Dim PriceSource As String
Dim DIAIDsToUpdate() As Long
Dim oRootLevel As TreeLevel
Dim i As Integer

Dim oDI As DetailItem
Dim oDIs As DetailItems

Dim NewDIA As Boolean

On Error GoTo ErrHandler

	CloseOnFinish = DlgValue("CloseOnFinish") = 1

	SourceQuantity = -1
	SourceName = -1
	SourceDescription = -1
	SourcePrice = - 1
	SourceUOM = -1

	Set oXL = CreateExcel

	oProject.StartTransaction

	If Not OpenSource Then GoTo e_ErrHandler

	Set oLevels = oProject.WorkSpace.Levels
	oLevels.Init oProject.Trees(oDocument.SelectedTree - 1).TreeLevels

	oLevels.TreeLevels.Index =  scIndexUnique
	Set oTreeLevel = oLevels.TreeLevels.Seek("PLANSWIFT")

	If oTreeLevel Is Nothing Then
		Set oRootLevel = oLevels.MoveFirst
		Set oTreeLevel = oRootLevel.TreeLevels.Add
		With oTreeLevel
			.Description = "PlanSwift Data"
			.Unique = "PLANSWIFT"
		End With
	End If

	Set oDIAs = oTreeLevel.DetailItemAssignments
	Set oDIs  = oProject.DetailItems

	' Start processing the data
	lRows = oWS.usedrange.rows.Count
	iColumns = oWS.usedrange.columns.Count

	lRow = 1
	iColumn = 1

	If RemoveExisting Then
		If Not RemoveDIAS(oDIAs) Then GoTo e_ErrHandler
		Set oDIAs = oTreeLevel.DetailItemAssignments
	End If

	' set column positions
	Do Until iColumn > iColumns
		ColumnHeader = UCase(Replace(Trim(oWS.cells(lRow, iColumn))," ", ""))

		Select Case ColumnHeader
			Case "NAME"
				SourceName = iColumn
			Case "TAKEOFF"
				SourceQuantity = iColumn
			Case "UNITS"
				SourceUOM = iColumn
			Case "PRICEEACH"
				SourcePrice = iColumn
		End Select

		iColumn = iColumn + 1
	Loop

	lRow  = 2
	Do Until lRow > lRows

		SetStatus "Processing row " & lRow & " of " & lRows & "..."

		If ImportItem(lRow) Then
			Set oDI = oDIs.Add
			Set oDIA = oDIAs.Add(oDI)
			UpdateDIA oDIA, lRow, True
		End If

		lRow = lRow + 1

	Loop

	oProject.CommitTransaction
	oProject.Total
	oDocument.Refresh True
	oDocument.SelectTreeLevel oTreeLevel.ID, True
	Process = True

	SetStatus "Ready"

e_ErrHandler:

	If Not Process Then
		If Not oProject Is Nothing Then
			oProject.RollbackTransaction
		End If
	End If

	SetStatus "Ready"

	Set oDI = Nothing
	Set oDIs = Nothing
	Set oDIA = Nothing
	Set oDIAs = Nothing
	Set oWS = Nothing
	Set oWB = Nothing
	CloseExcel oXL

	Exit Function

ErrHandler:

	CloseOnFinish = False	' override since we failed to import
	MsgBox "Error in Process function." & vbCrLf & vbCrLf & "[" & Err.Number & "] " & Err.Description ,vbExclamation, "Error"
	Process = False
	GoTo e_ErrHandler


End Function
Private Function ImportItem(Row As Long) As Boolean
Dim RetVal As Boolean

	RetVal = False

	If SourceQuantity <> -1 And SourceUOM <> -1 Then
		If IsNumeric(oWS.cells(Row, SourceQuantity).Value) And Len(oWS.cells(Row, SourceUOM)) > 0 Then
			RetVal = True
		End If
	End If

	ImportItem = RetVal

End Function

Private Sub UpdateDIA(DIA As DetailItemAssignment, Row As Long, NewItem As Boolean)

	If Not DIA Is Nothing Then
		With DIA
			If UPCTargetFieldSelectedIndex <> 0 Then
				' set the custom field selected for the upc code
				.CustomFields.ItemByPosition(UPCTargetFieldSelectedIndex).Value = oWS.cells(Row, SourceUPC).Value
			End If
			With .DetailItem
				If SourcePrice <> - 1 Then
					Select Case CostTargetFieldSelectedIndex
						Case 1
							.Labor = oWS.cells(Row, SourcePrice).Value
						Case 2
							.Equipment = oWS.cells(Row, SourcePrice).Value
						Case 3
							.Material = oWS.cells(Row, SourcePrice).Value
						Case 4
							.Other1 = oWS.cells(Row, SourcePrice).Value
						Case 5
							.Other2 = oWS.cells(Row, SourcePrice).Value
						Case 6
							.Other3 = oWS.cells(Row, SourcePrice).Value
					End Select
				End If
				If SourceUOM <> - 1 Then .UnitOfMeasure = Left(Trim(oWS.cells(Row, SourceUOM).Value), 10)
				If SourceName <> -1 Then .Description = Left(Trim(oWS.cells(Row, SourceName).Value), 255)
				.CostSource = "PlanSwift Import"
			End With
			If SourceQuantity <> -1 Then .Quantity = oWS.cells(Row, SourceQuantity).Value
		End With
	End If

End Sub

Private Function RemoveDIAS(ByVal DIAs As DetailItemAssignments) As Boolean
Dim DIAArray() As Long
Dim DIA As DetailItemAssignment

	On Error GoTo ErrHandler

	ReDim DIAArray(0)

	If Not DIAs Is Nothing And DIAs.Count > 0 Then

		Set DIA = DIAs.MoveFirst
		Do While Not DIA Is Nothing
			ReDim Preserve DIAArray(UBound(DIAArray) + 1)
			DIAArray(UBound(DIAArray)) = DIA.ID
			Set DIA = DIAs.MoveNext
		Loop

		DIAs.Index = scIndexID

		For i = 1 To UBound(DIAArray)
			Set oDIA = DIAs.Seek(DIAArray(i))
			If Not oDIA Is Nothing Then DIAs.Remove(oDIA)
		Next i

	End If

	RemoveDIAS = True

e_ErrHandler:

	Set DIA = Nothing

	Exit Function

ErrHandler:

	MsgBox "Error in RemoveDIAS function." & vbCrLf & vbCrLf & "[" & Err.Number & "] " & Err.Description ,vbExclamation, "Error"
	RemoveDIAS = False
	GoTo e_ErrHandler

End Function

Private Function GetDIAs(DIAs As DetailItemAssignments , Code As String) As Long()
Dim DIA As DetailItemAssignment
Dim IDList() As Long
Dim CodeToMatch As String
Dim CodeToCompare As String

	On Error GoTo ErrHandler

	ReDim IDList(0)

	CodeToMatch = Trim(UCase(Code))

	If Not DIAs Is Nothing Then
		Set DIA = DIAs.MoveFirst
		Do While Not DIA Is Nothing

			If UPCTargetFieldSelectedIndex <> 0 Then
				' match by our custom field
				CodeToCompare = UCase(DIA.CustomFields.ItemByPosition(UPCTargetFieldSelectedIndex).Value)
			Else
				' match by the dia code
				CodeToCompare = UCase(DIA.DetailItem.Code)
			End If

			If CodeToCompare = CodeToMatch Then
				ReDim Preserve IDList(UBound(IDList)+1)
				IDList(UBound(IDList)) = DIA.ID
			End If

			Set DIA =DIAs.MoveNext
		Loop
	End If

	GetDIAs = IDList

e_ErrHandler:

	Set DIA = Nothing
	Exit Function

ErrHandler:
	Erase GetDIAs
	GoTo e_ErrHandler

End Function
Public Function GetVersion(Application As Object) As Long

    On Error GoTo ErrHandler

    If Not Application Is Nothing Then
        GetVersion = CLng(Replace(Application.Version, ".", ""))
    End If

e_ErrHandler:

    Exit Function

ErrHandler:

    GetVersion = 0
    GoTo e_ErrHandler

End Function