recordset loop not looping

  • Thread starter Thread starter pubdude2003
  • Start date Start date
P

pubdude2003

the code below does not seem to loop properly, anyone have a notion? It runs
from a button on a form and it only writes the record that has Focus when the
button is activated.

On Error GoTo ErrHandler
Dim cnts1 As String
Dim cnts2 As String
Dim strPath As String
Dim strPath2 As String
Dim aFolders() As String
Dim I As Integer
Dim objHTTP As HTTP
Set rs = Me.RecordsetClone
Dim strJustFile As String

rs.MoveFirst
Do While Not rs.EOF

rs.Edit

cnts2 = Mid([Contents], 43, 5)

Set objHTTP = New HTTP
With objHTTP
.HttpURL = "http://webplace.com/" & cnts2 & ".zip"
.DestinationFile = "D:\2\" & cnts2 & ".zip"
If .FileExists Then .OverwriteTarget = True
If Not .IsConnected Then .DialDefaultNumber
.ConnectToHTTPHost
.WriteHTTPDataToFile
End With

Set objHTTP = Nothing
rs.Update
strPath = "D:/1/"
strPath = strPath + cnts2 'Left(cnts2, 5)
strPath2 = ("D:\2\" & cnts2 & ".zip")

If IsFileOpen(strPath2) Then
For y = 1 To 3000
Pause 1000
Next y
End If

aFolders = Split(strPath, "\")
strPath = vbNullString

For I = LBound(aFolders) To UBound(aFolders)
strPath = strPath & aFolders(I)
If Len(Dir(strPath, vbDirectory)) = 0 Then
MkDir strPath
End If
strPath = strPath & "/"
Next I

strPath2 = ("D:\2\" & cnts2 & ".zip")
Call UnzipIt(strPath2, strPath)

CurrentDb.Execute "INSERT INTO tblDirectory2" & _
" ( FileDate, subject, justfile )" & _
" VALUES ( '" & rs!Received & "', '" & rs!Subject & "', '" & rs!Contents
& "' )" ', dbFailOnError

rs.MoveNext
Loop
 
sorry I just noticed that it is logging the FileDate, Subject and Justfile
information as if it did loop through all the records, but it is definitely
only executing the download for the file noted in the field that has focus
when the button to execute the code is clicked.
 
Back
Top