'     VBScript created by Robert Smith - www.robertgsmith.com - robert@robertgsmith.com
'     Function: This will create a powerpoint slide from NWMLS download using the "Realty Tools Export" export profile
'     






On Error Resume Next

'Need CODE HERE - Get File Location
strPathtoTextFile = InputBox ("Please enter file location path:" & vbCrLF & vbCrLF & "Example:  C:\temp\resi_bbe\")


'===========================================================================
'  Connect to listings.txt file
'===========================================================================

Set objPPT = CreateObject("PowerPoint.Application")
Set objPresentation = objPPT.Presentations.Add
objPresentation.ApplyTemplate("C:\Program Files\Microsoft Office\Templates\Presentation Designs\Globe.pot")
'objPresentation.ApplyTemplate("C:\Documents and Settings\Robert\My Documents\templates\RobertGraySmith.pot")

'===========================================================================
'On Error Resume Next
'Set to Tab Delimited
'Need CODE HERE - Get File Location - Create SCHEMA.INI file

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001



'===========================================================================
'  Set Schema file for Tab Delimited
'===========================================================================
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(strPathtoTextFile & "schema.ini")
objFile.WriteLine("[listing.txt]" & vbCrLf & "Format=TabDelimited")
objFile.Close



'===========================================================================
'  Connect to listings.txt file
'===========================================================================
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")

objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & strPathtoTextFile & ";" & _
          "Extended Properties=""text;HDR=YES;FMT=Delimited"""

objRecordset.Open "SELECT * FROM listing.txt", _
          objConnection, adOpenStatic, adLockOptimistic, adCmdText



'===========================================================================
'  Create Powerpoint Slides
'===========================================================================
'**** CONTENT SLIDES ****

Do Until objRecordset.EOF
    'change style by () - eg: Slides.Add(X,9) = ppLayoutTextAndObject
    'Slides.Add(X,2) = ppLayoutTitleandText
    Set objSlide = objPresentation.Slides.Add(1, 2)
    Set objShapes = objSlide.Shapes

    Set objTitle = objShapes.Item(1)
    objTitle.TextFrame.TextRange.Text = objRecordset.Fields.Item("Address") &_
    ", " & objRecordset.Fields.Item("City Name") & Chr(13) &_
    "$" & objRecordset.Fields.Item("List Price") & vbTab & " DOM: " & objRecordset.Fields.Item("DOM") 

'======> WOULD LIKE JUST THE FIRST ITEM HYPERLINKED INSTEAD OF WHOLE FRAME -- HAVENT FIGURED OUT HOW TO TO THAT
strLinkStart = "http://idx.rtgstudio.com/IDXv4-snwmls/PropDetail.asp?pd=IDX&mls=SNWMLS&mlstbl=nwmlssoapRESI&mlsnum="
strLinkEnd = "&ucode=robertgsmith_com&office=&agent=&c=1&t=1&suplogo="

    Set objTitle = objShapes.Item(2)
    objTitle.TextFrame.TextRange.Text = objRecordset.Fields.Item("ML Number") &_
    Chr(13) & objRecordset.Fields.Item("Bedrooms") & " Bedrooms" &_
    Chr(13) & objRecordset.Fields.Item("Bathrooms") & " Bath" &_
    Chr(13) & objRecordset.Fields.Item("Sq Foot") & " Sq Feet" &_
    Chr(13) & Chr(13) & objRecordset.Fields.Item("Remarks")


With objTitle.TextFrame.TextRange.ActionSettings(1).Hyperlink
        .Address = strLinkStart & objRecordset.Fields.Item("ML Number") & strLinkEnd
        .SubAddress = ""
        .ScreenTip = "See listing detail"
     End With
    


'======> HELP NEEDED HERE the ppt slide created has a title object,
'======> a text field object and a clipart placeholder object -- just can't figure out the syntax to insert
'======>  the picture into the clipart placeholder.  VBA equivalant is listed in next couple lines.
 
    'ActiveWindow.Selection.SlideRange.Shapes("Rectangle 6").Select
    'ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="PATHNAME\PICTURE.png", _
    '  LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=144, Top:=126, Width:=432, Height:=288).Select



'======> in the interim, just using Title+Text Object and inserting picture.
'        ************Following code courtesy of cork_kyle@hotmail.com***********

strPicturePath = strPathtoTextFile & objRecordset.Fields.Item("ML Number") & ".jpg"
    'Set objPicture = objShapes.Item("Rectangle 4")
	'objPicture.delete
    'this for now -- still trying to figure out how to add to picture to existing object


   'the following 2 lines generate an error of "expected end of statement"
    	'Dim msoTrue As Long
    	'Dim msoFalse As Long

    msoTrue = -1
    msoFalse = 0

Call objShapes.AddPicture(strPicturePath, msoFalse, msoTrue, 320, 200, 380, 288)





   objRecordset.MoveNext
Loop

'**** ADD TITLE SLIDE ****
Set objSlide = objPresentation.Slides.Add(1, 1)
Set objShapes = objSlide.Shapes
    Set objTitle = objShapes.Item(1)
    objTitle.TextFrame.TextRange.Text = "Main Title"
    Set objTitle = objShapes.Item(2)
    objTitle.TextFrame.TextRange.Text = "Sub-Title"

'===========================================================================
'  Finish and show Powerpoint
'===========================================================================
objPPT.Visible = True