Just Code

This JustCode script shows you how to run a DMS script from within a mrs file. I use this allot in the automation systems i write for customers , a very useful bit of code.

 Dim oDMOMJob

Set oDMOMJob = CreateObject("DMOM.Job")

oDMOMJob.Load("c:\temp\MyFirstTransfer.dms", null)

oDMOMJob.Run()

Many moons ago , i needed to make a script that showed the users answer in a word doc. This JustCode script shows you how you can do it. Its creates a template for you and populates it.

Routing(Web)

' Set the survey Answers

Single = {A}
Multi = {A,B}
ToDaysDate="04/06/2010"

GridQuestion[{Sub1}].SingleCategoricalQuestionName = {A}
GridQuestion[{Sub2}].SingleCategoricalQuestionName = {B}
GridQuestion[{Sub3}].SingleCategoricalQuestionName = {C}
GridQuestion[{Sub4}].SingleCategoricalQuestionName = {D}
GridQuestion[{Sub5}].SingleCategoricalQuestionName = {E}

DoubleQuestioName = 12.12
LongQuestionName = 122
TextQuestionName = "This is a text question"
SingleWithOther._Other = "hello"
SingleWithOther = {_other}

Dim oWord,sFileName
Set oWord = CreateObject("Word.Application")
oWord.visible = true


' These two lines will make a template for us.
'oWord.Documents.Add()
'RunTemplate(oWord,IOM,False)


' These lines will use a template and show results
oWord.Documents.Open("D:DATASDLibraryPrintToWordSimpleTemplate.docx")
RunTemplate(oWord,IOM,True)


oWord.DisplayAlerts = false
'sFileName = "c:temp" + replace(replace(CText(DateNow()),"/","_"),":","_") + ".docx"
'oWord.ActiveDocument.SaveAs(sFileName)
oWord.Quit()

Sub MakeSpace(oWord)
' Jump out of table
oWord.Selection.MoveDown(5,1)

' Insert New line
oWord.Selection.TypeParagraph()

End Sub

Sub MakeTable(oWord,sLabel)
oWord.ActiveDocument.Tables.Add(oWord.Selection.range,2,1,1,0)

With oWord.Selection.Tables[1]
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With

oWord.Selection.Text = sLabel

End Sub

Sub Add2RowToTable(oWord,sLabel,sAnswerLabel,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer

End Sub

Sub Add1RowToTable(oWord,sLabel,sAnswerLabel,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer

End Sub

Sub AddSplitRowToTable(oWord,sLabel,sAnswerLabel,sAnswer,iRows,iCols)

oWord.Selection.MoveRight(12)
oWord.Selection.Cells.Split(iRows,iCols,True)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer

End Sub

Sub AddGridSplitRowToTable(oWord,sLabel,sAnswerLabel,sAnswer,iRows,iCols)

oWord.Selection.MoveRight(12)
oWord.Selection.Cells.Split(iRows,iCols,True)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer

End Sub

Sub AddGridRowToTable(oWord,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer

End Sub

Sub AddNextGridRowToTable(oWord,sLabel,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Text = sLabel

oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer

End Sub


Sub RunTemplate(oWord,IOM,bWithAnswers)
Dim oQuestion

For Each oQuestion in IOM.Questions
Select Case oQuestion.QuestionType
Case QuestionTypes.qtSimple
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"S","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"S","",oWord,0,IOM)
End If
Case QuestionTypes.qtLoopCategorical, QuestionTypes.qtLoopNumeric
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"G","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"G","",oWord,0,IOM)
End If
Case QuestionTypes.qtBlock, QuestionTypes.qtCompound, QuestionTypes.qtPage
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"G","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"G","",oWord,0,IOM)
End If
End Select
Next
End Sub

Sub FindAnswer(oWord,sLookingFor,sValue)

With oWord.Selection.Find
.Text = sLookingFor
.Replacement.Text = sValue
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWord.Selection.Find.Execute(,,,,,,,,,,1,,,,)
oWord.Selection.Font.Size = 10
oWord.Selection.HomeKey(6)

End Sub

Sub GetAnswers(oQuestion,sType,sLabel,oWord)
Dim oCat,oItem,oOther
Select Case sType
Case = "S"
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + "X",oQuestion.Response.Value)

Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText

FindAnswer(oWord,"X" + oQuestion.QuestionFullName + "X",oQuestion.Response.Value)


Case Else
For each oCat in oQuestion.Categories
If ( oCat.Value.Format("a") = oQuestion.Response.Value.Format("a") ) Then

FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X","Yes")

Else
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X","No")

End If
Next

' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + ":OtherTextX",oOTher.OtherQuestion.response.value)
Next
End Select
Case = "G"
For each oItem in oQuestion
If ( Find(oItem.ParentQuestion.QuestionFullname,"{") > -1 ) Then
GetAnswers(oItem,"S",oQuestion.ParentQuestion.Label,oWord)
Else
GetAnswers(oItem,"G",oQuestion.Label,oWord)
End If
Next
End Select
End Sub

Sub CreateQuestions(oQuestion,sType,sLabel,oWord,iQCount,oIOM)
Dim oCat,oItem,oOther,iCat
Select Case sType
Case = "S"
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
If ( sLabel = "" ) Then
Add1RowToTable(oWord,oQuestion.Label,"","X" + oQuestion.QuestionFullName + "X")
Else
Add1RowToTable(oWord,oQuestion.Label,"","X" + sLabel + "X")
End If
Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText
If ( sLabel = "" ) Then
Add1RowToTable(oWord,oQuestion.Label,"","X" + oQuestion.QuestionFullName + "X")
Else
Add1RowToTable(oWord,oQuestion.Label,"","X" + sLabel + "X")
End If

Case Else
iCat = 0
For each oCat in oQuestion.Categories

If iCat = 0 Then
If ( sLabel = "" ) Then
AddSplitRowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,2)
Else
AddSplitRowToTable(oWord,sLabel,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,2)
End If
Else
If ( sLabel = "" ) Then
Add2RowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
Add2RowToTable(oWord,sLabel,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If

End If
iCat = iCat + 1
Next

' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
If ( sLabel = "" ) Then
Add2RowToTable(oWord,oQuestion.Label,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
Else
Add2RowToTable(oWord,sLabel,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
End If
Next
End Select
Case = "GS"
'MakeTable(oWord,oQuestion.Label)
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText
Case Else
iCat = 0

For each oCat in oQuestion.Categories
If iCat = 0 Then
If ( iQCount = 2 ) Then
If ( sLabel = "" ) Then

AddGridSplitRowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,oQuestion.Categories.count+1)
Else
AddGridSplitRowToTable(oWord,sLabel,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,oQuestion.Categories.count+1)
End If
Else
'At This stage i need to know
'oIOM.Questions["GridQuestion"].categories["Sub1"].label

If ( sLabel = "" ) Then
AddNextGridRowToTable(oWord,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
AddNextGridRowToTable(oWord,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If
End If
Else
If ( sLabel = "" ) Then
AddGridRowToTable(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
AddGridRowToTable(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If

End If
iCat = iCat + 1
Next

' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
If ( sLabel = "" ) Then
AddSimpleTable(oWord,oQuestion.Label,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
Else
AddSimpleTable(oWord,sLabel,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
End If
Next
End Select
Case = "G"

For each oItem in oQuestion
iQCount = iQCount + 1
If ( Find(oItem.ParentQuestion.QuestionFullname,"{") > -1 ) Then
CreateQuestions(oItem,"GS",oQuestion.ParentQuestion.Label,oWord,iQCount,oIOM)
Else
CreateQuestions(oItem,"G",oQuestion.Label,oWord,iQCount,oIOM)
End If
Next
End Select
End Sub

End Routing

I have started using this allot in the last few months. This JustCode example will show you all the files and folders in a specific folder.

LoopFolders(“c:\temp”)
 
Sub LoopFolders(sFullPath)
 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
 debug.Log(oFolder.Path + “” + oFile.Name)
 Next
 
For each oSubFolder in oFolder.SubFolders
 debug.Log(“Folder:”+ oSubFolder.Name)
 LoopFolders(oSubFolder.Path)
 Next
 
End If
 
Set oFSO = null
 Set oFolder = null
 Set oFile = null
 End Sub

From time to time i find this very useful. This JustCode script will return the value of a question based on if it has an OffPath value or not.

Function WorkOutValue(oIOM,oQuestion,sReturn)
On Error Goto LogIt

if ( oQuestion.Response.value <> oQuestion.Info.OffPathResponse ) Then 

	if ( oQuestion.Info.OffPathResponse <> "" ) then
			
		select case sReturn
			Case = "V"
				WorkOutValue = ctext(oQuestion.Info.OffPathResponse)
			Case = "C"
				WorkOutValue = "{" + ctext(format(oQuestion.Info.OffPathResponse,"a")) + "}"
		End Select
	else
				
		select case sReturn
			Case = "V"
				WorkOutValue = ctext(oQuestion.Response.value)
			Case = "C"
				WorkOutValue = "{" + ctext(format(oQuestion.Response.value,"a")) + "}"
		End Select
		
	end if
Else
	
	select case sReturn
		Case = "V"
			WorkOutValue = ctext(oQuestion.Response.value)
		Case = "C"
			WorkOutValue = "{" + ctext(format(oQuestion.Response.value,"a")) + "}"
	End Select
End If

Goto SkipError

LogIt:
		
	oIOM.Terminate(Signals.sigError)
	
SkipError:

	On Error Goto 0	

		WorkOutValue = WorkOutValue
End Function

Over the years i have written many scripts. This JustCode script will show you how to make a file read only and then take it off again.

Dim sFileName

' Take of readonly
ShellExecute("attrib" ,,,"-r " + sFileName ,,0)

Want to send an email to someone using Lotus Notes. This script will help you do that.

' Tested on Notes Version 8.0

'Clean Up
Set Maildb = null
Set MailDoc = null
Set Body = null
Set Session = null

This JustCode script shows us how to open a file in read-only mode and loop through it a character at a time.

 ' ****************************************
' Designed by : Smarter Dimensions
' Last Updated : 24th July 2009
' Loop File a character at a time.
' ****************************************

Dim oFSO, oFile

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFile = oFSO.OpenTextFile("C:\temp\test.txt",1,false,0)

Do While oFile.AtEndOfStream = false
debug.Log(oFile.Read(1))
Loop


oFile.Close()