Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

help with error in my vbs slide show code

Status
Not open for further replies.
gibbo171

gibbo171

Programmer
Joined
Dec 13, 2007
Messages
33
Location
GB
Hi All

Markdmac has helped me hugely with my code in my previous thread but now i am yet again stuck and as things have moved on thought id start a new thread,


Can anyone tell me where the error is in my code please, i just get a blank IE screen when i run it

thanks

Gibbo

On Error Resume Next
Dim objFSO, oFO, oFolder, oFile, picDir, IE, Locus
Set objFSO = CreateObject("Scripting.FileSystemObject")
picDir = "C:\Documents and Settings\HP_Owner\Desktop\Slideshow\pics\"
Set oFolder = objFSO.GetFolder(picDir)
Set IE = CreateObject("InternetExplorer.Application")
IE.toolbar = False : IE.menubar = False : IE.statusbar = False : IE.Resizable = False

For Each oFile In oFolder.Files
If Right(oFile.Name,3) = "jpg" Or Right(oFile.Name,3) = "gif" Then

Locus = "file://" & Replace(oFile.ParentFolder,"\","/")&"/" & oFile.Name

With IE.document
.Open
.WriteLn "<HTML><HEAD>"
.WriteLn "<TITLE>HELLO!</TITLE></HEAD>"
.WriteLn "<BODY>"
.WriteLn "Hello world"
.WriteLn "<img src='" & Locus & "'><br>"
IE.Visible = True
WScript.Sleep 5000
.WriteLn "</BODY>"
.WriteLn "</HTML>"
.Close
End With
IE.Visible = True
WScript.Sleep 5000
End If
Next
Set IE = Nothing
Set objFSO = Nothing
 
Sort by date Sort by votes
Ok Got that working as follows but would also like to add some navigation buttons if anyone can help me out

Gibbo

On Error Resume Next
Dim objFSO, oFO, oFolder, oFile, picDir, IE, Locus
Set objFSO = CreateObject("Scripting.FileSystemObject")
picDir = "C:\Documents and Settings\HP_Owner\Desktop\Slideshow\pics\"

Set oFolder = objFSO.GetFolder(picDir)
Set IE = CreateObject("InternetExplorer.Application")
With IE
.left=200
.top=200
.height=140
.width=250
.menubar=0
.toolbar=0
.statusBar=0
.navigate "About:Blank"
.visible=1
End With

'wait a while until IE as finished to load
Do while IE.busy
loop


For Each oFile In oFolder.Files
If Right(oFile.Name,3) = "jpg" Or Right(oFile.Name,3) = "gif" Then
Locus = "file://" & Replace(oFile.ParentFolder,"\","/")&"/" & oFile.Name

With IE.document
.Open
.WriteLn "<HTML><HEAD>"
.WriteLn "<TITLE>HELLO!</TITLE></HEAD>"
.WriteLn "<BODY>"
.WriteLn "Hello world<br><Br>"

.WriteLn "<img src='" & Locus & "'><br>"



.WriteLn "</BODY>"
.WriteLn "</HTML>"
.Close
End With

WScript.Sleep 2000
End If
Next

Set IE = Nothing
WScript.Quit(0)
 
Upvote 0 Downvote
Latset Version, still need help with those buttons though

Function HelloWorld()

MsgBox "Hello World"

End Function



On Error Resume Next
Dim objFSO, oFO, oFolder, oFile, picDir, IE, Locus
Set objFSO = CreateObject("Scripting.FileSystemObject")
picDir = "C:\Documents and Settings\HP_Owner\Desktop\Slideshow\pics\"

Set oFolder = objFSO.GetFolder(picDir)
Set IE = CreateObject("InternetExplorer.Application")
With IE

.menubar=0
.toolbar=0
.statusBar=0
.navigate "About:Blank"

End With

'wait a while until IE as finished to load
Do while IE.busy
loop


For Each oFile In oFolder.Files
If Right(oFile.Name,3) = "jpg" Or Right(oFile.Name,3) = "gif" Then
Locus = "file://" & Replace(oFile.ParentFolder,"\","/")&"/" & oFile.Name

With IE.document
.Open
.WriteLn "<HTML><HEAD>"
.WriteLn "<script type=" & Chr(34) & "text/vbscript" & Chr(34) & ">Function HelloWorld() MsgBox " & Chr(34) & "Hello World" & Chr(34) & " End Function </script>"
.WriteLn "<TITLE>Slide Show</TITLE></HEAD>"
.WriteLn "<BODY>"
.WriteLn "Title<br><Br>"
.WriteLn "<input type='button' name='BuyNow' value='Start' onClick='helloWorld()' /><Br><BR>"
.WriteLn "<img src='" & Locus & "'><br>"
.WriteLn "</BODY>"
.WriteLn "</HTML>"
.Close
End With
IE.Visible = True
WScript.Sleep 2000
End If
Next


Set IE = Nothing
Set objFSO = Nothing
WScript.Quit(0)
 
Upvote 0 Downvote
Mark, using what you had already showed me and a lot of head scratching i managed to link a Javascript Slideshow into a VBScript routine, so it auto generates a slideshow for me based on my images on my local folder, still not got the auto rotate bit working properly but massive step further forward from where I was, Im still sure there must be an easier way in pure vbscript though!!!!

see what you think

Gibbo



On Error Resume Next
Dim objFSO, oFO, oFolder, oFile, picDir, IE, Locus
Set objFSO = CreateObject("Scripting.FileSystemObject")
picDir = "C:\Documents and Settings\HP_Owner\Desktop\Slideshow\pics\"

Set oFolder = objFSO.GetFolder(picDir)
Set IE = CreateObject("InternetExplorer.Application")
With IE

.menubar=0
.toolbar=0
.statusBar=0
.navigate "About:Blank"

End With

'wait a while until IE as finished to load
Do while IE.busy
loop

With IE.document
.Open
.WriteLn "<Head>"
.WriteLn "<Title> Briefing</Title>"
.WriteLn "<SCRIPT LANGUAGE=" & Chr(34) & "JavaScript" & Chr(34) & ">"
.WriteLn "<!-- Begin var rotate_delay = 2000; // delay in milliseconds (5000 = 5 secs)"
.WriteLn "current = 0;"
.WriteLn "function next() {"
.WriteLn "if (document.slideform.slide[current+1]) {"
.WriteLn "document.images.show.src = document.slideform.slide[current+1].value;"
.WriteLn "document.slideform.slide.selectedIndex = ++current;"
.WriteLn "}"
.WriteLn "else first();"
.WriteLn "}"
.WriteLn "function previous() {"
.WriteLn "if (current-1 >= 0) {"
.WriteLn "document.images.show.src = document.slideform.slide[current-1].value;"
.WriteLn "document.slideform.slide.selectedIndex = --current;"
.WriteLn "}"
.WriteLn "else last();"
.WriteLn "}"
.WriteLn "function first() {"
.WriteLn "current = 0;"
.WriteLn "document.images.show.src = document.slideform.slide[0].value;"
.WriteLn "document.slideform.slide.selectedIndex = 0;"
.WriteLn "}"
.WriteLn "function last() {"
.WriteLn "current = document.slideform.slide.length-1;"
.WriteLn "document.images.show.src = document.slideform.slide[current].value;"
.WriteLn "document.slideform.slide.selectedIndex = current;"
.WriteLn "}"
.WriteLn "function ap(text) {"
.WriteLn "document.slideform.slidebutton.value = (text == " & Chr(34) & "Stop" & Chr(34) & ") ? " & Chr(34) & "Start" & Chr(34) & " : " & Chr(34) & "Stop" & Chr(34) & ";"
.WriteLn "rotate();"
.WriteLn "}"
.WriteLn "function change() {"
.WriteLn "current = document.slideform.slide.selectedIndex;"
.WriteLn "document.images.show.src = document.slideform.slide[current].value;"
.WriteLn "}"
.WriteLn "function rotate() {"
.WriteLn "if (document.slideform.slidebutton.value == " & Chr(34) & "Stop" & Chr(34) & ") {"
.WriteLn "current = (current == document.slideform.slide.length-1) ? 0 : current+1;"
.WriteLn "document.images.show.src = document.slideform.slide[current].value;"
.WriteLn "document.slideform.slide.selectedIndex = current;"
.WriteLn "window.setTimeout(" & Chr(34) & "rotate()" & Chr(34) & ", rotate_delay);"
.WriteLn " }"
.WriteLn "}"
.WriteLn "// End -->"
.WriteLn "</script>"
.WriteLn "</HEAD>"
.WriteLn "<BODY>"
.WriteLn "<center>"
.WriteLn "<form name=slideform>"
.WriteLn "<table cellspacing=1 cellpadding=4 bgcolor=" & Chr(34) & "#000000" & Chr(34) & ">"
.WriteLn "<tr>"
.WriteLn "<td align=center bgcolor=" & Chr(34) & "white" & Chr(34) & ">"
.WriteLn "<b>Image Slideshow</b>"
.WriteLn "</td>"
.WriteLn "</tr>"
.WriteLn "<tr>"
.WriteLn "<td align=center bgcolor=" & Chr(34) & "white" & Chr(34) & " width=600 height=400>"
.WriteLn "<img src=" & Chr(34) & " & Chr(34) & " name=" & Chr(34) & "show" & Chr(34) & ">"
.WriteLn "</td>"
.WriteLn "</tr>"
.WriteLn "<tr>"
.WriteLn "<td align=center bgcolor=" & Chr(34) & "#C0C0C0" & Chr(34) & ">"


.WriteLn "<select name=" & Chr(34) & "slide" & Chr(34) & " onChange=" & Chr(34) & "change();" & Chr(34) & ">"


For Each oFile In oFolder.Files
If Right(oFile.Name,3) = "jpg" Or Right(oFile.Name,3) = "gif" Then
Locus = "file://" & Replace(oFile.ParentFolder,"\","/")&"/" & oFile.Name
.WriteLn "<option value =" & Chr(34) & Locus & Chr(34) & ">" & oFile.Name & "</option>"
End If
Next


.WriteLn "</select>"
.WriteLn "</td>"
.WriteLn "</tr>"
.WriteLn "<tr>"
.WriteLn "<td align=center bgcolor=" & Chr(34) & "#C0C0C0" & Chr(34) & ">"
.WriteLn "<input type=button onClick=" & Chr(34) & "first();" & Chr(34) & " value=" & Chr(34) & "|<<" & Chr(34) & " title=" & Chr(34) & "Beginning" & Chr(34) & ">"
.WriteLn "<input type=button onClick=" & Chr(34) & "previous();" & Chr(34) & " value=" & Chr(34) & "<<" & Chr(34) & " title=" & Chr(34) & "Previous" & Chr(34) & ">"
.WriteLn "<input type=button name=" & Chr(34) & "slidebutton" & Chr(34) & " onClick=" & Chr(34) & "ap(this.value);" & Chr(34) & " value=" & Chr(34) & "Start" & Chr(34) & "title=" & Chr(34) & "AutoPlay" & Chr(34) & ">"
.WriteLn "<input type=button onClick=" & Chr(34) & "next();" & Chr(34) & " value=" & Chr(34) & ">>" & Chr(34) & " title=" & Chr(34) & "Next" & Chr(34) & ">"
.WriteLn "<input type=button onClick=" & Chr(34) & "last();" & Chr(34) & " value=" & Chr(34) & ">>|" & Chr(34) & " title=" & Chr(34) & "End" & Chr(34) & ">"
.WriteLn "</td>"
.WriteLn "</tr>"
.WriteLn "</table>"
.WriteLn "</form>"
.WriteLn "</center>"
.WriteLn "</body>"

.Close
End With

IE.Visible = True

Set IE = Nothing
Set objFSO = Nothing
WScript.Quit(0)
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Peterdo
  • Locked
  • Question Question
Read code
Replies
1
Views
572
strongm
strongm
lunter
  • Locked
  • Question Question
How to create vbArray+vbByte (8209) in *.vbs stript
Replies
0
Views
619
lunter
lunter
jtm2020hyo
  • Locked
  • Question Question
What is wrong with this code?
Replies
3
Views
760
strongm
strongm
wchull
  • Locked
  • Question Question
How do I resolve this permissions error in my script?
Replies
0
Views
632
wchull
wchull
bdwilcox
  • Locked
  • Question Question
HTA fails with Syntax Error when working VBScript inserted
Replies
2
Views
939
bdwilcox
bdwilcox

Part and Inventory Search

Sponsor

Back
Top