Jeg har problemer med at StillExecuting ikke bliver ændret. I de kode
eksempler jeg har set anvendes DoEvents, men det findes ikke VB Script.
Hvad kan man anvende i stedet ??? Hvis jeg indsætter en MsgBox så virker
det. Desværre kan jeg ikke bruge den metode da det skal køre som en
batch process.
Her er Min kode:
dim fso, ftpo, Temp, FileList, TxtFile
url = "ftp://" & &(1:)
usr = &(2:)
pwd = &(3:)
FileList = ""
set fso = CreateObject("Scripting.FileSystemObject")
set ftpo = CreateObject("InetCtls.Inet.1") 'Msinet.ocx
With ftpo
.Cancel
.Protocol = icFTP
.URL = url
.UserName = usr
.Password = pwd
.Execute , "DIR"
End With
On Error Resume Next
MsgBox "Denne besked skal være der ......"
If ftpo.ResponseCode = 0 Then
&(6:) = " "
Else
&(6:) = "ERR"
End If
Select Case State
Case icResponseCompleted
Temp = ftpo.GetChunk(1024)
Do While Len(Temp) > 0
FileList = FileList & Temp
Temp = ftpo.GetChunk(1024)
Loop
'MsgBox "Færdig med at hente DIR fra " & url
'MsgBox "FileList: " & FileList
Case icError
MsgBox "Hent VejReister fra CPR bliver afsluttet pga. følgende fejl: "
& vbCrLf & ftpo.icResponseCode & ":" & ftpo.icResponseInfo
Case Else
MsgBox "Hent VejReister fra CPR bliver afsluttet nu, da den ikke blev
færdig"
ftpo.Cancel
End Select
&(5:) = FileList
If Not fso.FileExists (&(4:)) Then
Set TxtFile = fso.CreateTextFile(&(4:))
End If
set TxtFile = fso.OpenTextFile(&(4:),2, True)
TxtFile.Write(FileList)
TxtFile.Close
FileArray = Split(FileList, vbCrLf)
FileArray = Filter(FileArray, ".")
MsgBox "Fundne filer: " & UBound(FileArray)
'ftpo.Execute , "BIN"
'While ftpo.StillExecuting
'MsgBox "Status på BIN: " & ftpo.ResponseCode & " " & ftpo.ResponseInfo
& vbCrLf & "StillExecuting: " & ftpo.Stillexecuting
'Wend
For i = 1 To UBound(FileArray)
If Len(FileArray(i)) > 0 Then
FileArray(i) = Right(FileArray(i), 15)
RemoteFile = FileArray(i)
LocalFile = "c:\Download\VejReg\" & FileArray(i)
MsgBox "File " & i & ": Fra : " & RemoteFile & " Til: " & LocalFile
ftpo.Execute , "GET " & RemoteFile & " " & LocalFile
On Error Resume Next
Do Until Not ftpo.StillExecuting
For count = 1 To 1000
Next
MsgBox "Status: " & State & "Kode: " & ftpo.ResponseCode & " " &
ftpo.ResponseInfo & vbCrLf & "StillExecuting: " & ftpo.Stillexecuting
Loop
ftpo.Cancel
End If
Next
Set ftpo = Nothing
Set fso = Nothing
--
Leveret af:
http://www.kandu.dk/
"Vejen til en hurtig løsning"