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 Chris Miller 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
Dec 13, 2007
33
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
Read code
Replies
1
Views
271
strongm
strongm
lunter
  • Locked
  • Question
How to create vbArray+vbByte (8209) in *.vbs stript
Replies
0
Views
250
lunter
lunter
jtm2020hyo
  • Locked
  • Question
What is wrong with this code?
Replies
3
Views
292
strongm
strongm
wchull
  • Locked
  • Question
How do I resolve this permissions error in my script?
Replies
0
Views
247
wchull
wchull
bdwilcox
  • Locked
  • Question
HTA fails with Syntax Error when working VBScript inserted
Replies
2
Views
405
bdwilcox
bdwilcox

Part and Inventory Search

Sponsor

Back
Top