Code Sample:
Website Design, Data Extract Solutions

By Dave Johnstone



Sub Main
' This PixieRobot script logs on to a PICK account, extracts PICK data,
' creates emails, stores in Excel, and creates a HTML page.
Call LogMessage("*** Start PixieWeb extract from PICK file ****")

If CheckFileExists("C:\Program Files\PixieRobot\pixieweb_test.ini") Then
    Call LogMessage("*** INI file found - diplaying parameters")
Else
    Call LogMessage("ERROR - INI file cannot be found - script aborted")
    Exit Sub
End If

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile("C:\Program Files\PixieRobot\pixieweb_test.ini")

DIM objXL, objWb
Set objXL = CreateObject ("Excel.Application")
Set objWb = objXL.WorkBooks.Open("C:\Program Files\PixieRobot\Pickdata.xls")
Set objWb = objXL.ActiveWorkBook.WorkSheets

Dim Pixie
Set Pixie = CreateObject("PixieWeb.clsAgent")
Dim XType, XTickle, XSuccess, XLog, XTitle
Dim UserID1, Password1, UserID2, Password2

' **** Read INI file for LOGIN parameters which could be hard-coded in script ****
While Not ts.AtEndOfStream
    INIRecord = ts.ReadLine
    If Instr(1, INIRecord, "#", 1) = 0 Then
        If Instr(1, INIRecord, "UserID1", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            UserID1 = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("UserID1 = " & UserID1)
        ElseIf Instr(1, INIRecord, "UserID2", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            UserID2 = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("UserID2 = " & UserID2)
        ElseIf Instr(1, INIRecord, "UnixPrompt", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            UnixPrompt = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("UnixPrompt = " & UnixPrompt)
        ElseIf Instr(1, INIRecord, "Password1", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            Password1 = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("Password1 = " & Password1)
        ElseIf Instr(1, INIRecord, "Password2", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            Password2 = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("Password2 = " & Password2)
        ElseIf Instr(1, INIRecord, "Account", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            AdpAccount = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("AdpAccount = " & AdpAccount)
        ElseIf Instr(1, INIRecord, "TimeOut", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            Pixie.TimeOut = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("Pixie.TimeOut = " & Pixie.TimeOut)
        ElseIf Instr(1, INIRecord, "Host", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            Pixie.Host = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("Pixie.Host = " & Pixie.Host)
        ElseIf Instr(1, INIRecord, "Port", 1) > 0 Then
            aPos = Instr(1, INIRecord, "=", 1)
            aPos = aPos + 1
            bPos = Len(INIRecord) + 1
            Pixie.Port = Mid(INIRecord, aPos, bPos - aPos)
            Call LogMessage ("Pixie.Port = " & Pixie.Port)
        End If
    End If
Wend

Pixie.ExecuteCompareMethod = 1
Call Pixie.Connect("{AUTO}")
PickResponse = Pixie.Response

' **** About to Login ****
Call Pixie.ExecuteET(UserID1, "Password:")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error1 with Logon at User1 = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If
If Instr(1, PickResponse, "Password:", 1) = 0 Then
    Call LogMessage("Error2 with Logon at User1 = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET(Password1, "$")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at Password1 = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET(UnixPrompt, "...:")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at Unix Prompt = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET(UserID2, "Password:")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at User2 = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET(Password2, "continue.")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at Password2 = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET("", "19H")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET(AdpAccount, "19H")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at ADP a/c = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET("TCL", ":")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at TCL = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET("WHO", ":")
PickResponse = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at WHO = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

' ********************** Extract FI-WIP file ******************************
ListCmd = "LIST FI-WIP (H,N)"
Call Pixie.ExecuteET(ListCmd, ":")

PickData = Pixie.Response
If Pixie.State = "ERROR" Then
    Call LogMessage("Error with LIST = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

Call Pixie.ExecuteET("OFF", "$")
PickResponse = Pixie.Response

If Pixie.State = "ERROR" Then
    Call LogMessage("Error with Logon at OFF = " & Pixie.State)
    objXl.Quit
    Exit Sub
End If

' **** Create header script for HTML file ****
o = "<html>"
o = o & "<head>" & vbcrlf
o = o & "<title>Example HTML output</title>" & vbcrlf
o = o & "</head>" & vbcrlf
o = o & "<body bgcolor=" & chr(34) & "#FFCC99" & chr(34) & ">" & vbcrlf
o = o & "<p><font size=" & chr(34) & "3" & chr(34) & "><b> Example HTML List for ADP</b></font><br>" & vbcrlf
o = o & " Date = " & Date & "</p>" & vbcrlf
o = o & "<table>" & vbcrlf
o = o & " <tr>" & vbcrlf
o = o & " <td><p><b>Name</b></p></td>" & vbcrlf
o = o & " <td><p><b>Street</b></p></td>" & vbcrlf
o = o & " <td><p><b>City</b></p></td>" & vbcrlf
o = o & " <td><p><b>State</b></p></td>" & vbcrlf
o = o & " <td><p><b>Zip</b></p></td>" & vbcrlf
o = o & " <td><p><b>Phone</b></p></td>" & vbcrlf
o = o & " <td><p><b>Make</b></p></td>" & vbcrlf
o = o & " <td><p><b>Model</b></p></td>" & vbcrlf
o = o & " </tr>" & vbcrlf

' Extract individual records from input string
PickRecs = Split(PickResponse, "FI-WIP")
NumberRecs = UBound(PickRecs)
Call LogMessage("Number PICK records extracted = " & NumberRecs)
If Instr(1, PickRecs(1), "[401] NO ITEMS PRESENT", 1) > 0 Then
    Call LogMessage("**** No items found in FI-WIP ****")
    objXl.Quit
    Exit Sub
End If

For i = 2 to NumberRecs
    Call LogMessage("Processing Pick Record = " & i)
    ' Extract data fields
    PickDataFields = Split(PickRecs(i), vblf)
    NumberFields = UBound(PickDataFields)
    Call LogMessage("Number PICK fields extracted = " & NumberFields)
    OBN = "no"
    For k = 0 to NumberFields
        PickDataFields(k) = Replace(PickDataFields(k), vbcrlf, "")
        Call LogMessage("Pick Data Field = " & PickDataFields(k))

        ' **** Write to Excel file ****
        If Instr(1, PickDataFields(k), "BUYER-NAME", 1) > 0 Then
            If OBN = "no" Then
                aPos = Instr(1, PickDataFields(k), ". ", 1)
                aPos = aPos + 4
                bPos = Len(PickDataFields(k)) + 1
                ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
                objXl.Cells(i, 1).value = ActualData
                ObuyerName = ActualData
                OBN = "yes"
            End If
        ElseIf Instr(1, PickDataFields(k), "BUYER-STREET", 1) > 0 Then
            aPos = Instr(1, PickDataFields(k), ". ", 1)
            aPos = aPos + 4
            bPos = Len(PickDataFields(k)) + 1
            ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
            objXl.Cells(i, 2).value = ActualData
            ObuyerStreet = ActualData
        ElseIf Instr(1, PickDataFields(k), "BUYER-CITY", 1) > 0 Then
            aPos = Instr(1, PickDataFields(k), ". ", 1)
            aPos = aPos + 4
            bPos = Len(PickDataFields(k)) + 1
            ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
            objXl.Cells(i, 3).value = ActualData
            ObuyerCity = ActualData
        ElseIf Instr(1, PickDataFields(k), "BUYER-STATE", 1) > 0 Then
            aPos = Instr(1, PickDataFields(k), ". ", 1)
            aPos = aPos + 4
            bPos = Len(PickDataFields(k)) + 1
            ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
            objXl.Cells(i, 4).value = ActualData
            ObuyerState = ActualData
        ElseIf Instr(1, PickDataFields(k), "BUYER-ZIP", 1) > 0 Then
            aPos = Instr(1, PickDataFields(k), ". ", 1)
            aPos = aPos + 4
            bPos = Len(PickDataFields(k)) + 1
            ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
            objXl.Cells(i, 5).value = ActualData
            ObuyerZip = ActualData
        ElseIf Instr(1, PickDataFields(k), "BUYER-PHONE-1", 1) > 0 Then
            aPos = Instr(1, PickDataFields(k), ". ", 1)
            aPos = aPos + 4
            bPos = Len(PickDataFields(k)) + 1
            ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
            objXl.Cells(i, 6).value = ActualData
            ObuyerPhone = ActualData
        ElseIf Instr(1, PickDataFields(k), "MAKE-VEHICLE", 1) > 0 Then
            aPos = Instr(1, PickDataFields(k), ". ", 1)
            aPos = aPos + 4
            bPos = Len(PickDataFields(k)) + 1
            ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
            objXl.Cells(i, 7).value = ActualData
            OMakeVehicle = ActualData
        ElseIf Instr(1, PickDataFields(k), "MODEL-VEHICLE", 1) > 0 Then
            aPos = Instr(1, PickDataFields(k), ". ", 1)
            aPos = aPos + 4
            bPos = Len(PickDataFields(k)) + 1
            ActualData = Mid(PickDataFields(k), aPos, bPos - aPos)
            objXl.Cells(i, 8).value = ActualData
            OModelVehicle = ActualData
        End If
    Next

    ' **** Write to email file ****
    ' NOTE: the emails can be sent with PixieRobot. Attachments could contain the data.
    OemailAddr = "dave@thetotalco.com"
    eMaildoc = eMaildoc & "Date: " & Date & " " & Time & vbCrLf
    eMaildoc = eMaildoc & "To: " & OemailAddr & vbCrLf
    eMaildoc = eMaildoc & "From: " & chr(34) & "PixieWare Software" & chr(34) & " " & vbCrLf
    eMaildoc = eMaildoc & "Subject: This is an email test...." & vbCrLf
    eMaildoc = eMaildoc & "Cc:" & vbCrLf
    eMaildoc = eMaildoc & "Bcc:" & vbCrLf
    eMaildoc = eMaildoc & "X-Attachments: " & vbCrLf & vbCrLf
    eMaildoc = eMaildoc & "Hello " & ObuyerName & "," & vbCrLf & vbCrLf
    eMaildoc = eMaildoc & "This is a test email." & vbCrLf
    eMaildoc = eMaildoc & "Thanks." & vbCrLf
    eMaildoc = eMaildoc & "Dave." & vbCrLf
    oEmailMsg = eMaildoc & vbCrLf
    fIlename = "c:\Program Files\PixieRobot\MsgOut\ADPmailMsg_" & i & ".txt"
    Call OutputToFile(oEmailMsg, fIlename)
    eMaildoc = ""

    ' **** Write each record to HTML file ****
    o = o & " <tr>" & vbcrlf
    o = o & " <td>>" & ObuyerName & " </p> </td>" & vbcrlf
    o = o & " <td> <p>" & ObuyerStreet & " </p> </td>" & vbcrlf
    o = o & " <td> <p>" & ObuyerCity & " </p> </td>" & vbcrlf
    o = o & " <td> <p>" & ObuyerState & " </p> </td>" & vbcrlf
    o = o & " <td> <p>" & ObuyerZip & " </p> </td>" & vbcrlf
    o = o & " <td> <p>" & ObuyerPhone & " </p> </td>" & vbcrlf
    o = o & " <td> <p>" & OMakeVehicle & " </p> </td>" & vbcrlf
    o = o & " <td> <p>" & OModelVehicle & " </p> </td>" & vbcrlf
    o = o & " </tr>" & vbcrlf

    ' Clear fields in case a blank field encountered.
    ObuyerName = ""
    ObuyerStreet = ""
    ObuyerCity = ""
    ObuyerState = ""
    ObuyerZip = ""
    ObuyerPhone = ""
    OMakeVehicle = ""
    OModelVehicle = ""
Next

' **** Create HTML footer script and write .HTM file ****
o = o & " </table>" & vbcrlf
o = o & " </body>" & vbcrlf
o = o & " </html>" & vbcrlf
Call OutputToFile(o, "C:\Program Files\PixieRobot\Pickhtml_test.htm", True)

objXl.Quit
ts.Close
Set Pixie = Nothing

End Sub

' ***** Start of Functions *****
Function CheckFileExists(sFileName)
    ' Check to see if required text file exists
    Dim FileSystemObject
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

    If (FileSystemObject.FileExists(sFileName)) Then
        CheckFileExists = True
    Else
        CheckFileExists = False
    End If

    Set FileSystemObject = Nothing
End Function




Discover Our Products and Services

Start I.T.

Web I.T.

Dig I.T.

Contract I.T.

Of I.T.

Grab I.T.

Designed and built by: Designed and built by PixieWare Software

Turn your WEB vision into reality!

Let us
provide
a website quote

Website Build Package
Creation of website (maximum 5 pages). Price: CDN$350 per website, $100 of fee due as an up-front downpayment, and $250 of fee due on project completion. Package does not include any additional external fees related to the project (e.g.):

  • Domain-name registration fee (annual fee)
  • Website hosting fee (monthly or annual fee)
  • Email-accounts processing fee (if relevant, a monthly or annual fee)
  • Any other fee related to domain name re-location or change of name server

Turn your WEB vision into reality!