Learn VBA

Create a nested folder structure with the file system object.

by

We needed to make some nested folder structures for a project we are running with mrs scripts and i thought i would post some code to do that.  I am sure there are many ways to do this , but this is what we did in just a few lines

 

Dim sPath , oItem, sCurrentPath,oFSO


Set oFSO = CreateObject("Scripting.FileSystemObject")

For each oItem in split("C:\Temp\Doug\Doug1\Doug2\","\")

if ( find(oItem,":") > -1 ) then 
      sCurrentPath = oItem + "\"
else
      sCurrentPath = replace(sCurrentPath + "\" + oItem,"\\","\")
End If

If oFSO.FolderExists(sCurrentPath) = False Then
      debug.Log(sCurrentPath)
      oFSO.CreateFolder(sCurrentPath)
End If


Next

Just Code : Delete all files with specific month

by

I needed a quick bit of code today so that i could clean up my hard disk. This script will delete all the files that match a specific month number. One day it may save you a few minutes.

LoopFolders("D:\Servers\116\SQLBackups",10)

Sub LoopFolders(sFullPath,iMonth)
Dim oFolder,oSubFolder,oFSO,oFile

Set oFSO = CreateObject("Scripting.FileSystemObject")

If oFSO.FolderExists(sFullPath) Then
Set oFolder = oFSO.GetFolder(sFullPath)

For Each oFile In oFolder.Files
if ( Month(oFile.DateCreated) = iMonth ) Then
debug.Log(oFolder.Path + "\" + oFile.Name +":" + ctext(oFile.DateCreated))
oFSO.DeleteFile(oFolder.Path + "\" + oFile.Name)
End If
Next

For each oSubFolder in oFolder.SubFolders
debug.Log("“Folder:"+ oSubFolder.Name)
LoopFolders(oSubFolder.Path,iMonth)
Next

End If

Set oFSO = null
Set oFolder = null
Set oFile = null
End Sub

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

JustCode : Delete Empty columns of data

by

This mrs script shows you how you can use mrs files to make and run a dms file that will strip out any columns that do not have any data in.

Step 1: Open the VQ file and make an MDD FILE.

Dim mrDSCs, mrMdsc, oDoc,sVQ

sVQ = "C:\temp\FILE"
    Set mrMdsc = createobject("mrdscreg.components")
    Set mrMDSC = mrMdsc["mrScDsc"]

    Set oDoc = mrMdsc.Metadata.Open(sVQ + ".vq")
        oDoc.Save(sVQ + ".mdd")
        oDoc.Close()

Set oDoc = Null

Step 2: Take the MDD file and loop the variable instances


Dim oMDM, oVar
Dim sSQL,oConnection,oRecordset

' Create the MDM object
Set oMDM = CreateObject("MDM.Document")
    oMDM.Open("C:\temp\FILE.mdd", , 1)

    For Each oVar in oMDM.Variables
        'if oVar.IsSystem = False then
            debug.Log("Question Name : " + oVar.FullName)

            ' Start code to check if the field has data in it.
            Set oConnection = CreateObject("ADODB.Connection")
                oConnection.ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrScDSC;Location=C:\temp\FILE.VQ;Initial Catalog=C:\temp\FILE.mdd"
                oConnection.Open()

            If ( oConnection.State = 1 ) Then
                Set oRecordset = CreateObject("ADODB.Recordset")
                    oRecordset.Open("SELECT count(respondent.serial) FROM VDATA WHERE " + oVar.FullName + " is not null" ,oConnection,3,1)
                    If ( oRecordset.EOF = true and oRecordset.BOF = true ) Then
                        sSQL = sSQL
                    ELSE
                        sSQL = sSQL + oVar.FullName + ","
                    End if
                Set oRecordset = Null

            End If

            oConnection.Close()
            Set oConnection = Null
    ' end if
Next

oMDM.Close()
sSQL = Left(sSQL,len(sSQL)-1)
debug.Log(sSQL)

Step 3: Create the dms file with the select statement in it.


Dim oFSO, oFile

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFile = oFSO.CreateTextFile("C:\temp\FILE.dms", True)


oFile.WriteLine("InputDatasource(Input, """")")
oFile.WriteLine("    ConnectionString = ""Provider=mrOleDB.Provider.2;Data Source=mrScDSC;Location=C:\temp\FILE.vq;Initial Catalog=C:\temp\FILE.mdd"" ")
oFile.WriteLine("    SelectQuery = ""SELECT " + sSQL + " FROM VDATA""")
oFile.WriteLine("End InputDatasource")
oFile.WriteLine("")
oFile.WriteLine("OutputDatasource(Output, """")")
oFile.WriteLine("    ConnectionString = ""Provider=mrOleDB.Provider.2;Data Source=mrSavDsc;Location=C:\temp\Final.sav""")
oFile.WriteLine("    MetaDataOutputName = ""C:\temp\Final.mdd""")
oFile.WriteLine("End OutputDatasource")

oFile.Close()

Set oFSO = Null

Step 4: Run the file


Dim oDMOMJob

Set oDMOMJob = CreateObject("DMOM.Job")

oDMOMJob.Load("C:\temp\FILE.dms", null)

oDMOMJob.Run()

JustCode : Function to return the current connection string

by

This code shows us how to open up an MDD and read the conenction string properties to get the current connection string settings.

 
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 5th July 2009
' Function to return the current connection string of an MDD
' ****************************************

Dim sConnection, oMDM

Set oMDM = CreateObject("MDM.Document")

oMDM.Open("c:\temp\short_drinks.mdd", , openConstants.oREAD)

sConnection = GetConnectionStringFromMDM(oMDM)

debug.Log(sConnection)

oMDM.close()

Function GetConnectionStringFromMDM(oDoc)
Dim oDataLinkHelper, sConnectionString

Set oDataLinkHelper = CreateObject("MROLEDB.DataLinkHelper")
sConnectionString = "Provider=mrOleDB.Provider.2;"
sConnectionString = sConnectionString + "Data Source=" + oDoc.DataSources.Current.cDscName + ";"
sConnectionString = sConnectionString + "Location=""" + oDoc.DataSources.Current.DbLocation + """;"
sConnectionString = sConnectionString + "MR Init MDM Document=" + oDataLinkHelper.CreateDocumentObjectString(oDoc) + ";"
sConnectionString = sConnectionString + "MR Init Project=" + oDoc.DataSources.Current.Project + ";"
GetConnectionStringFromMDM = sConnectionString

End Function

JustCode : Make an MDD file from a VQ file using DSC

by

This code shows you how to open an surveycraft metatdata file using the Surveycraft dsc and save it as a MDD file.

 
' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 7th July 2009
' Code to make an MDD file from a VQ file using the SC dsc
' ****************************************

Dim mrDSCs, mrMdsc, oDoc,sVQ

sVQ = "C:\temp\MUSEUM"

Set mrMdsc = createobject("mrdscreg.components")
Set mrMDSC = mrMdsc["mrScDsc"]

Set oDoc = mrMdsc.Metadata.Open(sVQ + ".vq")

oDoc.Save(sVQ + ".mdd")

oDoc.Close()

Set oDoc = Null

Learn VBA : Sort an Array

by

I quite often, to get ideas for articles look at the things people search for on the site. And recently I did just that and noted that someone looked up how to do a VBA array sort. If that was you , then this quick article is for you.

First off lets define the array and populate it.

Dim oArray[10]
     
    oArray[0] = "J"
    oArray[1] = "I"
    oArray[2] = "H"
    oArray[3] = "D"
    oArray[4] = "F"
    oArray[5] = "G"
    oArray[6] = "E"
    oArray[7] = "B"
    oArray[8] = "C"
    oArray[9] = "A"

In this example we are going to do a bubble sort, but there are lots of different types. Bubble is by far the easiest at the cost of speed, it is by no means the fastest sort.

    
   
Dim iFirst,iLast,iCount,iNestCount
Dim sTemp,sList
     
    iFirst = LBound(oArray) 
    iLast = UBound(oArray) 
    For iCount = iFirst To iLast - 1 
        For iNestCount = iCount + 1 To iLast 
            If oArray[iCount] > oArray[iNestCount] Then 
                sTemp = oArray[iNestCount] 
                oArray[iNestCount] = oArray[iCount]
                oArray[iCount] = sTemp 
            End If 
        Next
    Next

So what does our code do, well we first of we find the first record in our array and then we find the last , and then we begin to loop our array. Next we start to loop the array again , starting with the element we are on and checking to see if any of the following elements are greater than the one we currently have selected in the first loop , if it is greater then we swap them around and then continue on , so to help you visualise this, this is what happens

iCount = 0,  Array[iCount] = J / iNestCount = 1,  Array[iNestCount] = I
SWAP,  Array[iCount] = I / Array[iNestCount] = J
iCount = 0,  Array[iCount] = I / iNestCount = 2,  Array[iNestCount] = H
SWAP,  Array[iCount] = H / Array[iNestCount] = I
iCount = 0,  Array[iCount] = H / iNestCount = 3,  Array[iNestCount] = D
SWAP,  Array[iCount] = D / Array[iNestCount] = H
iCount = 0,  Array[iCount] = D / iNestCount = 4,  Array[iNestCount] = F
iCount = 0,  Array[iCount] = D / iNestCount = 5,  Array[iNestCount] = G
iCount = 0,  Array[iCount] = D / iNestCount = 6,  Array[iNestCount] = E
iCount = 0,  Array[iCount] = D / iNestCount = 7,  Array[iNestCount] = B
SWAP,  Array[iCount] = B / Array[iNestCount] = D
iCount = 0,  Array[iCount] = B / iNestCount = 8,  Array[iNestCount] = C
iCount = 0,  Array[iCount] = B / iNestCount = 9,  Array[iNestCount] = A

and this keeps on going until we have looped round all the items in the array. Are final bit of code just lets us display the results.

     
    For iCount = 1 To UBound(oArray) 
        sList = sList + oArray[iCount] 
    Next 
    
    Debug.MsgBox(sList)

So there you have it some code to sort an array. I hope you find it useful. Please don’t forget if you cannot find what you want , leave a comment on the “ASK US post” and I will respond to you with an answer if I can.

Learn VBA : String Manipulation

by

The next article in our line of learn VBA will teach you how to use some of the most common string manipulation commands. These commands are easy to learn and are actually quite common among most programming languages. The commands we will look at are Len for “length”,Mid for “middle” , left & Right and then finally Replace and Split.

Read more