SantiagoPagnone
4/1/2015 - 1:35 PM

Exportar a Excel CSV exporta contactos a Archivo Excel csv

Exportar a Excel CSV exporta contactos a Archivo Excel csv

CONST sFullFielName = ""
			'Modo de apertura del archivo csv
			CONST ForReading = 1, ForWriting = 2, ForAppending = 8 
			'Columnas que se sincronizan
			CONST sColumns = 		"EMAIL1,DISPLAYNAME,NAME,SURNAME,ORGANIZATION,REGION,TELEPHONE,OTHERPHONE,MOBILE,HOMESTREET,DOC_ID"
			CONST sColumnsExch = 	"DocId,ExternalEmailAddress,DisplayName,FirstName,LastName,ORGANIZATION,StateOrProvince,Phone,OtherTelephone,MobilePhone,StreetAddress,Name"
			
			CONST sDirectoryFileRepository = "C:\Program Files (x86)\Gestar\web\crm\contacts"
			'Session global
			
			Dim oFolderContacts 
			Dim iLimitPage : iLimitPage = 100
            set fld = dSession.FoldersGetFromid(2403)
            SyncAllContacts fld
			'Sync all contacts
			Function SyncAllContacts(Folder)
				Set dSession = Folder.Session
				'Dim oDom : Set oDom = Folder.Search(sColumns&"","contactType=0","")
				Dim sFullExporFileName : sFullExporFileName = "SyncAll_" & GetDateString() & ".csv" 
				CreatetCSVFile sFullExporFileName, sColumnsExch,ForWriting
				
				
				Set oFolderContacts = Folder ' dSession.FoldersGetfromid(2403)
				Dim bContinueFlag : bContinueFlag = True
				Dim oDomToProcess
				Dim lastDocId : lastDocId = "0"
				Dim iCounter :iCounter = 0
				Do While bContinueFlag
					Set oDomToProcess = GetPartialDom(lastDocId,bContinueFlag)
					If Not bContinueFlag Then 
						Exit Do
					End If
					Dim sVal : sVal = GetValues(oDomToProcess)
					CreatetCSVFile sFullExporFileName, sVal,ForAppending
					iCounter = iCounter + 1
					dSession.DebugPrint "counter " & iCounter
				Loop
				SyncAllContacts = 0
				
			End Function
			
			'Sync modified contact
			Function SyncModifyContact(Doc)
				
				Set dSession = Doc.Parent.Session
				Dim oDom : Set oDom = Doc.Parent.Search(sColumns&"","contactType=0 and doc_id="&Doc.id,"")
				Dim sFullExporFileName : sFullExporFileName = "SyncModify_" & GetDateString() & ".csv" 
				CreatetCSVFile sFullExporFileName, sColumnsExch,ForWriting
				
				Dim sVal : sVal = GetValues(oDom)
				CreatetCSVFile sFullExporFileName, sVal,ForAppending
				RunPowerSehll sFullExporFileName
				DeleteCSVFile sFullExporFileName
				SyncModifyContact = oDom.documentElement.childNodes.length
			End Function
			
		
			
			'Coming soon
			Function SyncDeleteContact(Doc)
				Set dSession = Doc.Parent.Session
				SyncDeleteContact = 1
			End Function

			'*********************************************
			'Helpper Methods
			'*********************************************
			'Retrieve partial Dom using iLimitPage like limit
			Function GetPartialDom(lastDocId,bContinueFlag)
				Dim sFilter : sFilter = "contactType = 0  and doc_id > " & lastDocId
				Set oDom = oFolderContacts.Search(sColumns&"",sFilter&"","doc_id",iLimitPage&"")
				
				If oDom.documentElement.ChildNodes.length &"" = iLimitPage &"" Then
					lastDocId =  oDom.documentElement.ChildNodes(oDom.documentElement.ChildNodes.length-1).getAttribute("doc_id")&""
				Else
					lastDocId=""
					bContinueFlag = False
				End If
				Set GetPartialDom = oDom
			End Function
						
			
			'Gets values from csv body document
			Function GetValues(oDom)
				Dim sValues	:	sValues =""
				Dim arrCol	:	arrCol = split(sColumns,",")
                Dim i,oNode
				Dim iCount
				Dim sFinalValue
				Dim iTotalCount : iTotalCount = oDom.documentElement.ChildNodes.length
				for each oNode in oDom.documentElement.ChildNodes
					iCount = iCount +1
					For i = 0 To Ubound(arrCol)
						if sValues & "" <> "" Then
							sValues = sValues & ","
						End if
						dim sVal :sVal = Trim(oNode.getAttribute(LCASE(arrCol(i)&""))&"")
						'dSession.debugPrint "nombre: " & LCASE(arrCol(i)&"") & "  valor: " &  Trim(oNode.getAttribute(LCASE(arrCol(i)&""))&"")
						if sVal& "" ="" Then sVal = "-"
						sValues = sValues & """" & sVal &""""
					Next
					
					if iCount < iTotalCount Then
						sFinalValue = sFinalValue & sValues & ""  & vbNewline
						'sValues = sValues & ""  & vbNewline
					End if
					sValues = ""
				next
				GetValues = sFinalValue
			End Function
			

			'Procedimiento de creacion del archivo CSV
			'Se utiliza para crear el archivo, agregar sus columnas y tambien sus valores, en modo append.
			Sub CreatetCSVFile(sFullFileName,sValues,iMode)
				Dim filesys
				On Error Resume Next
					Set filesys = CreateObject("Scripting.FileSystemObject") 
					Dim sPath : sPath = sDirectoryFileRepository & "/" &sFullFileName
					Set filetxt = filesys.OpenTextFile(sPath, iMode, True) 
					filetxt.WriteLine(sValues) 
					filetxt.Close 
					If err.number <> 0 Then
						dSession.ErrRaise "*Creacion o Agregado  CSV: " & cntModulo &  " sPath: " & sPath &" Error: " & err.number & " description: " & err.description
					End if
				On Error GoTo 0
			End Sub
			
			'Procedimiento de borrado del archivo CSV
			'Si la ejecucion de syncro es correcta se elimina el archivo
			Sub DeleteCSVFile(sFullFileName)
				Dim filesys
				On Error Resume Next
					Set filesys = CreateObject("Scripting.FileSystemObject") 
					Dim sPath : sPath = sDirectoryFileRepository & "/" &sFullFileName
					filesys.DeleteFile(sPath) 
					If err.number <> 0 Then
						dSession.ErrRaise "*Borrado de CSV: " & cntModulo & " sPath: " & sPath & " Error: " & err.number & " description: " & err.description
					End if
				On Error GoTo 0
			End Sub
			Function ScriptControl(Timeout)
				Dim oSC
				Set oSC = CreateObject("ScriptControl")
				With oSC
					.Language = "VBScript"
					.AllowUI = False
					.Timeout = Timeout
				End With
				Set ScriptControl = oSC
			End Function
			
			Function RunPowerSehll(sFileName)
					On error Resume Next
					Dim iResult : iResult = 0
					Set objShell = CreateObject("Wscript.shell")
					'dim sCommand : sCommand = "powershell -noexit  -ExecutionPolicy RemoteSigned -file """ & sDirectoryFileRepository &"\ImportContacts.ps1"" -csvFileName """ &  sDirectoryFileRepository & "/" &sFileName&""""
					dim sCommand : sCommand = "powershell -ExecutionPolicy RemoteSigned -file """ & sDirectoryFileRepository &"\ImportContactsMail.ps1"" -csvFileName """ &  sDirectoryFileRepository & "/" &sFileName&""""
					
					dSession.debugPrint " PRES " & sCommand
					'Llama al procedimiento que conecta con el exchange y sincroniza el CSV creado
					' 1 Parametro: comando a ejecutar
					' 2 Parametro: implcia que no se abre ninguna ventana de powershell es modo silent.
					' 3 Parametro: la llamada es sincrona, es decir el scripting espera el fin de ejecucion
					objShell.run sCommand,0,True 
					if err.number &""<> "0" Then
						dSession.debugPrint " *ERROR: " & cntModulo & " RunPowerShell file: " &sFileName
						dSession.debugPrint "  Err.Number		: " & Err.Number 
						dSession.debugPrint "  Err.Description	: " & Err.Description 
						iResult = 1
					else
						dSession.debugPrint " Ejecucion de syncronizacion de contactos correcta. " & sCommand
					End if
					Set objShell= nothing
				On error GoTo 0
				RunPowerSehll = iResult
			End Function
			
			'Return Date as String
			Function GetDateString()
				Dim dNow : dNow = Now
				Dim sDateValue : sDateValue = DatePArt("d",dNow)&""&datePart("m",dNow)&""&datePart("yyyy",dNow)&""&DatePart("h", dNow)&""&DatePart("n", dNow)&""&DatePart("s", dNow)
				GetDateString = sDateValue
			End Function