准备下载网上的图片,地址是批量的准确地址,就是做了个循环后总提示:
实时错误 37564  正在执行上一要求
 我把代码贴出来,麻烦大家帮看看,积分没了,有时间的朋友帮下吧,非常感谢.
[code]Public Conn As New ADODB.Connection
Public MdbName As String
Public MdbPass As String
Public Rs As New ADODB.Recordset
Public Rs2 As New ADODB.Recordset
Public SqlStr As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
---------------------------------------------------------------------------------
Public Function ConnOpen(ByVal MdbFileName As String, ByVal DataPass As String) As Boolean
 *************** '打开数据库这里都没有问题
  Conn.Open
End Function
---------------------------------------------------------------------------------Private Sub Command1_Click()
   
MdbName = "gg.mdb"
MdbPass = ""
ConnOpen MdbName, MdbPass      SqlStr = "Select * FROM clcp order by 批次 asc"
    
   Rs.Open SqlStr, Conn, 1, 1
   
For i = 1 To 1    savefile.Text = "http://www.autoinfo.gov.cn/mlsw/" & Rs("照片") & ".jpg"
    
    StartDownLoad savefile
    
NextRs.Close
Conn.Close
End Sub
----------------------------------------------------------------------------
Private Sub StartDownLoad(ByVal Geturl As String)
Dim spo%, filename$
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(App.Path & "\download") Then Set f = fso.CreateFolder(App.Path & "\download")
spo = InStrRev(Geturl, "/")
filename = Right(Geturl, Len(Geturl) - spo) '获取文件名
savefile.Text = App.Path & "\download\" & filename
'Do
'Sleep 1000
'Loop While Inet1.StillExecuting = FalseInet1.Execute Geturl, "get"   '开始下载End Sub
--------------------------------------------------------------------------------------Private Sub Inet1_StateChanged(ByVal State As Integer)
   'State = 12 时,用 GetChunk 方法检索服务器的响应。
   Dim vtData() As Byte
   Select Case State
   '...没有列举其它情况。
   Case icError '11
      '出现错误时,返回 ResponseCode 和 ResponseInfo。
      vtData = Inet1.ResponseCode & ":" & Inet1.ResponseInfo
   Case icResponseCompleted ' 12
      Dim bDone As Boolean: bDone = False
      '取得第一个块。
      vtData() = Inet1.GetChunk(1024, 1)
      DoEvents
      Open savefile.Text For Binary Access Write As #1     '设置保存路径文件后开始保存
      '获取下载文件长度
      If Len(Inet1.GetHeader("Content-Length")) > 0 Then ProgressBar1.Max = CLng(Inet1.GetHeader("Content-Length"))
      
      '循环分块下载
      Do While Not bDone
         Put #1, Loc(1) + 1, vtData()
         vtData() = Inet1.GetChunk(1024, 1)
         DoEvents
         ProgressBar1.Value = Loc(1)   '设置进度条长度
         If Loc(1) >= ProgressBar1.Max Then bDone = True
      Loop     Close #1   Label1.Caption = "下载完成"
   End Select
   
End Sub
[/code]

解决方案 »

  1.   

    刚才代码没贴出来:
    Public Conn As New ADODB.Connection
    Public MdbName As String
    Public MdbPass As String
    Public Rs As New ADODB.Recordset
    Public Rs2 As New ADODB.Recordset
    Public SqlStr As String
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    -----------------------------------------------------------------------------------
    Public Function ConnOpen(ByVal MdbFileName As String, ByVal DataPass As String) As Boolean
    *******************这部分为打开数据库  没问题的
    Conn.Open
    End Function
    -----------------------------------------------------------------------------------
    Private Sub Command1_Click()
       
    MdbName = "gg.mdb"
    MdbPass = ""
    ConnOpen MdbName, MdbPass      SqlStr = "Select * FROM clcp order by 批次 asc"
        
       Rs.Open SqlStr, Conn, 1, 1
       
    For i = 1 To 1    savefile.Text = "http://www.autoinfo.gov.cn/mlsw/" & Rs("照片") & ".jpg"
        
        StartDownLoad savefile
        
    NextRs.Close
    Conn.Close
    End Sub
    -----------------------------------------------------------------------------------
    Private Sub Form_Load()
    'savefile.Text = "http://www.autoinfo.gov.cn/mlsw/" 'App.Path
    End SubPrivate Sub StartDownLoad(ByVal Geturl As String)
    Dim spo%, filename$
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(App.Path & "\download") Then Set f = fso.CreateFolder(App.Path & "\download")
    spo = InStrRev(Geturl, "/")
    filename = Right(Geturl, Len(Geturl) - spo) '获取文件名
    savefile.Text = App.Path & "\download\" & filename
    'Do
    'Sleep 1000
    'Loop While Inet1.StillExecuting = FalseInet1.Execute Geturl, "get"   '开始下载End Sub
    -----------------------------------------------------------------------------------
    Private Sub Inet1_StateChanged(ByVal State As Integer)
       'State = 12 时,用 GetChunk 方法检索服务器的响应。
       Dim vtData() As Byte
       Select Case State
       '...没有列举其它情况。
       Case icError '11
          '出现错误时,返回 ResponseCode 和 ResponseInfo。
          vtData = Inet1.ResponseCode & ":" & Inet1.ResponseInfo
       Case icResponseCompleted ' 12
          Dim bDone As Boolean: bDone = False
          '取得第一个块。
          vtData() = Inet1.GetChunk(1024, 1)
          DoEvents
          Open savefile.Text For Binary Access Write As #1     '设置保存路径文件后开始保存
          '获取下载文件长度
          If Len(Inet1.GetHeader("Content-Length")) > 0 Then ProgressBar1.Max = CLng(Inet1.GetHeader("Content-Length"))
          
          '循环分块下载
          Do While Not bDone
             Put #1, Loc(1) + 1, vtData()
             vtData() = Inet1.GetChunk(1024, 1)
             DoEvents
             ProgressBar1.Value = Loc(1)   '设置进度条长度
             If Loc(1) >= ProgressBar1.Max Then bDone = True
          Loop     Close #1   Label1.Caption = "下载完成"
       End Select
       
    End Sub
      

  2.   

    明  21:06:29
    我把需要运行的文件打包过去
    明  21:06:56
    如果
    for  i= 1 to 1 
    是可以完成下载的
    笨兔兔  21:07:28
    你单步跟踪了么??
    明  21:08:05
    单步跟踪不现实触发Inet1_StateChanged
    明  21:08:09
    显示
    笨兔兔  21:10:41
    For i = 1 To 2    savefile.Text = " http://www.autoinfo.gov.cn/mlsw/" & Rs("照片") & ".jpg"
        
        StartDownLoad savefile
        
    Next
    笨兔兔  21:10:56
    你为什么没有rs.movenext??
    明  21:11:09
    恩  我加上了 
    明  21:11:29
    刚才改了你这个不是死循环了
    明  21:11:33
    所以我加上了
    明  21:11:46
    好像成功了  我正在试
    明  21:13:18
    你刚才说的Inet1_StateChanged需要开关变量时怎么做呢?
    明  21:13:30
    它是触发执行的啊
    笨兔兔  21:15:18
    你已经做了。现在还有什么问题么??
    明  21:15:42
    恩  现在成功了   可以下载做个图片了 
    明  21:16:10
    你在我的贴子上随便回复下  我给你分分
    明  21:16:30
    但是我现在还没明白什么原因呢 
    笨兔兔  21:17:08
    rs.movenext是因为你第一次和第二次都是一样的东西,没分别了
    笨兔兔  21:17:27
    你一开始注销的时候,判断的逻辑有错误
    明  21:17:41
    恩   主要是那个DO循环  它实际上起到作用了吗 看不出来
    笨兔兔  21:17:44
    还有就是sleep后加个doevents应该比较好
    笨兔兔  21:17:55
    起到作用了,你一开始判断错了
      

  3.   


    其实主要问题不是上面引用的问题,

    'Do 
    'Sleep 1000 
    'Loop While Inet1.StillExecuting = False 
    这句判断错了