Month: April 2018

Send SMTP Email via Gmail

by

Just helped someone get this sorted and thought i woulds share. The trick was to allow Less Secure apps in your account. Here is the link

https://myaccount.google.com/lesssecureapps?pli=1

Turn it on and then just use the normal CDO code.

Dim oEmail, sEmailFrom, sEmailTo, sEmailSubject, sEmailBody,sBCC

' Send email

sEmailTo = "admin@SmarterDimensions.com"
sEmailFrom = "FromAddress@SmarterDimensions.com"
sEmailSubject = "Email Subject"
sEmailBody = "Email Body this is bold"
sBCC = "SmarterDimensions@live.com.au"


Set oEmail      = CreateObject("CDO.Message")

With oEmail
 With .Configuration.Fields
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpusessl"] = True
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpserver"] = "smtp.gmail.com"
  .Item["http://schemas.microsoft.com/cdo/configuration/sendusing"] = 2
  .Item["http://schemas.microsoft.com/cdo/configuration/sendusername"] = "douglas.porton@gmail.com"
  .Item["http://schemas.microsoft.com/cdo/configuration/sendpassword"] = "xxxxxxxxxxx"	
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpserverport"] = 465
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"] = 60
  .Item["http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"] = 1	
  .Update()		
 End With
End With	

    
oEmail.From     = sEmailFrom
oEmail.To       = sEmailTo
oEmail.BCC      = sBCC
oEmail.Subject  = sEmailSubject
oEmail.HTMLBody = sEmailBody

oEmail.Send()

set oEmail = Null

Open SAV file and create an XL map of contents

by

Needed to write some code today to open up an Statistics sav file and create an XL map file of the metadata. The next step in the process will be to write a IBM Statistics syntax script to change the content in the SAV file based on the information in the XL file. Here is the first bit of the code , lets call it stage 1. If you want stage 2 let me know.

So lets declare some vars 

CONST sDataPath = "c:\temp"
CONST sDataName = "IBV_A069_EPH.sav"
CONST sXLMap = "SAV_MAP.xls"


Dim oDSCs, oDSC, oMDM, oVar,oElement
Dim oExcel,oSheet

Dim iVarCount,iRow

And now lets go ahead and open up the SAV file using the Statistics DCS

Set oDSCs = CreateObject("MRDSCReg.Components")
Set oDSC = oDSCs["mrSavDsc"]
Set oMDM = oDSC.Metadata.Open(sDataPath + sDataName)

Then lets open up our XL file. I am assuming it is already made and contains a tab called Labels in it. We are also going to give the columns some names

Set oSheet = oExcel.Sheets["Labels"]
oSheet.Activate()
	
iRow = 1
oSheet.cells[1][1].value = "Variable Name"
oSheet.cells[1][2].value = "New Variable Name"
oSheet.cells[1][3].value = "Type"
oSheet.cells[1][4].value = "Value"
oSheet.cells[1][5].value = "Label"

Next we need to loop the variables in the file outputting the data we find to the relevant places in our sheet

	for iVarCount = 0 to oMDM.Variables.count-1
		iRow = iRow + 1
		Set oVar = oMDM.Variables[iVarCount]	
		
			oSheet.cells[iRow][1].value = oVar.Name
			oSheet.cells[iRow][3].value = "L"
			oSheet.cells[iRow][5].value = TextOnly(oVar.Label)
		
			oSheet.cells[iRow][6].value = oVar.dataType

			For each oElement in oVar.Elements.Elements
	   			iRow = iRow + 1
	   			oSheet.cells[iRow][3].value = "C"
	   			oSheet.cells[iRow][4].value = oElement.Element.NativeValue
	   			oSheet.cells[iRow][5].value = TextOnly(oElement.Label)	   			
   			Next
   		
	Next
oMDM.Close()

and finally we need out TextOnly Function. This will allow us to strip out HTML codes that may be in our labels

Function TextOnly(sValue)
	Dim sNew,iCount,bStart
	For iCount = 0 to len(sValue) -1
		
		if ( find( "<",mid(sValue,iCount,1) )>-1 ) then 
			bStart = true
		End if
			
		if ( bStart = true ) Then
		else
			sNew = sNew + mid(sValue,iCount,1)
		End If
			
		if ( find( ">",mid(sValue,iCount,1) )>-1 ) then 
			bStart = false
		End if
	Next
	TextOnly = sNew
End Function

JustCode : Delete a vdata record

by

This sub shows us how to delete a vdata record from a survey. It has 3 parms that you need to pass in. You will also need to enter a valid SQL user login & password.

 
' sSurvey: The name of the survey that is to be used.
' sID: The Respondent.serial that is to be deleted.
' sServer: The name or the IP of the SQL server
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 8th July 2009
' Sub to delete a vdata record
' ****************************************

Sub DeleteVDataRecord(sSurvey,sID,sServer)

    Set oConnection = CreateObject("ADODB.Connection")

    oConnection.ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrRdbDsc2;Location='Provider=SQLOLEDB.1;Password=XXXXXX;Persist Security Info=True;User ID=XX;Initial Catalog=" + sSurvey + ";Data Source=" + sServer + "';Initial Catalog=\" + sServer + "SPSSMR_FMROOTMaster" + sSurvey + "" + sSurvey + ".mdd;MR Init Project=" + sSurvey

    oConnection.Open()

    If ( oConnection.State = 1 ) Then

        Set oRecordset = CreateObject("ADODB.Recordset")
        oRecordset.Open("DELETE FROM VDATA WHERE Respondent.serial = '" + sID + "'" ,oConnection,3,1)
        Set oRecordset = Null

    End If

    oConnection.Close()
    Set oConnection = Null

End Sub