Convert Syntax To Script
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | Option Explicit Sub Main ' This script converts the syntax of the Designated Syntax Window into ' the corresponding script format. The resulting syntax, is pasted at the end ' of the Designated Syntax Window. ' Requirements: ' Single and double quotes cannot be used in the same line of syntax ' The last line of syntax must end with a carriage return. ' Raynald Levesque 2003/07/13. Dim objSyntaxDoc As ISpssSyntaxDoc Dim strLine As String Dim strSynCmd As String Dim intPos As Integer Dim strScript As String Set objSyntaxDoc=objSpssApp.GetDesignatedSyntaxDoc Debug.Clear Call test 'Used to test resulting script strSynCmd = objSyntaxDoc.Text Debug.Print strSynCmd intPos = InStr(strSynCmd,vbCrLf) strScript = vbCrLf & "**** Script version of above syntax." & vbCrLf & vbCrLf & _ "Dim strCmd as string" & vbCrLf While intPos > 0 'need to replace double quotes by single quotes & skip empty lines strLine = Left(strSynCmd, intPos -1) Debug.Print Len(strLine) strSynCmd = Mid(strSynCmd, intPos + 2) intPos = InStr(strSynCmd, vbCrLf) strScript = strScript & "strCmd = strCmd & " & QuoteLine(strLine) & " & vbCrLf" & vbCrLf Wend Debug.Print strSynCmd objSyntaxDoc.Text = objSyntaxDoc.Text & strScript & vbCrLf & _ "objSpssApp.ExecuteCommands (strCmd,False)" End Sub Sub test () End Sub Function QuoteLine(strText As String) As String Const strDoubleQuote As String =Chr(34) Const strSingleQuote As String =Chr(39) strText=Replace$(strText,strDoubleQuote,strSingleQuote) QuoteLine = strDoubleQuote & strText & strDoubleQuote End Function |
Related pages
...