標題: [發問] 下載中斷問題 [打印本頁]

---

作者: spermbank    時間: 2013-11-16 01:37     標題: 下載中斷問題

大家好:

      想請問個問題，因為我下載會中斷，如圖所示。
      不知道有沒有辦法加個程式碼，可以直接判斷，而不造成下載過程有無法開啟的狀況。
     謝謝。

---

作者: luhpro    時間: 2013-11-16 09:30

本帖最後由 luhpro 於 2013-11-16 09:33 編輯

回復 1# spermbank
這種情形最常見的處理方式就是加上錯誤處理.

因為附檔在我的 Excel 2003 執行時會一直有錯誤,
所以我自己另外做了一個檔案,
你可以參照著修改你的程式.

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   Dim i%, j&
   
3.   Dim bErr As Boolean
   
4.   
   
5.   On Error GoTo errGet
   
6.   
   
7.   bErr = False
   
8.   For i = 1 To 6
   
9.     j = j + i
   
10.     If i = 3 Then Err.Raise 1004 ' 此行模擬網頁讀取失敗,發生 1004 錯誤
    
11.     If Not bErr Then
    
12.       MsgBox "執行讀取網頁的動作, i = 3 時會模擬發生錯誤, 目前 i =" & i
    
13.     Else
    
14.       MsgBox "網頁讀取失敗後的處理,例 : 重讀, 等幾秒..., i = 3 時會模擬發生錯誤, 目前 i =" & i
    
15.       bErr = False
    
16.     End If
    
17.   Next
    
18.   
    
19. On Error GoTo 0
    
20. Exit Sub
    
21.   
    
22. errGet:
    
23.   If Err.Number = 1004 Then bErr = True
    
24.   Resume Next
    
25. End Sub

複製代碼

[attach]16725[/attach]

---

作者: spermbank    時間: 2013-11-16 21:39

回復 2# luhpro

您好:
      不知道如何加入您給我的程式碼，但是更新的時候會再.Refresh這一行出現錯誤。
可以再請多指教一些嗎? 謝謝。

Sub 下載基本資料()


    Range("P" & 23).Formula = "更新開始..." '.改
    Application.ScreenUpdating = False

    Sheets("DDE").Select
    x = Application.WorksheetFunction.CountA(Range("A:A")) '欄位有值範圍計算
   
    With ThisWorkbook


    For Each a In .Sheets("DDE").Range("A" & 1418, "A" & x - 1).SpecialCells(xlCellTypeConstants).Offset(1) '設定範圍  '==========要減1============

    更新資料 a '執行12檔案更新

    Workbooks("風險評估.xlsx").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '複製工作表

    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Base\" & CStr(a) & ".xlsx" '另存新檔

    關檔

    Next

    End With
   
    Sheets("DDE").Select
    Range("P" & 23).Formula = "更新結束" '.改
    Application.ScreenUpdating = True
End Sub

Sub 更新資料(a)

    Dim Sh As Worksheet, MyURL$, MyQy As QueryTable

    With ThisWorkbook

    fd = .Path & "\基本面\風險評估\"

    fs = Dir(fd & "*.xlsx")

    Do Until fs = ""

    With Workbooks.Open(fd & fs)
   
    For Each Sh In .Sheets

        With Sh

        If .QueryTables.Count > 0 Then

            Set MyQy = .QueryTables(1)

            With .QueryTables(1)

            MyURL = .Connection

            If InStr(MyURL, "StockID") > 0 Then

                k = Val(Split(MyURL, "=")(UBound(Split(MyURL, "="))))

                Else

                k = Val(Split(MyURL, "_")(1))

            End If

            MyURL = Replace(MyURL, k, a)

            .Connection = MyURL '更改查詢

            .BackgroundQuery = False '幕前更新
            
            .Refresh '更新

            End With

        End If

        End With

    Next

    End With

    fs = Dir()

    Loop

    End With

End Sub

Sub 關檔()

    For Each w In Windows

    If w.Caption <> ThisWorkbook.Name Then w.Close 1

    Next

End Sub

---

作者: luhpro    時間: 2013-11-16 22:38

本帖最後由 luhpro 於 2013-11-16 22:50 編輯

回復 3# spermbank
以下程式放在 Module 內 :

1. Public bStop As Boolean

複製代碼

Sub 下載基本資料()
  .
  .
  .
    更新資料 a '執行12檔案更新
   If bStop Then Exit For
  .
  .
  .
End Sub


Sub 更新資料(a)
  Dim Sh As Worksheet, MyURL$, MyQy As QueryTable
  Dim iI%, lJ&, OpenForms  
  .
  .
  .
  On Error GoTo errGet
              .Refresh '更新
  On Error GoTo 0
            End With
        End If
        End With
    Next
    End With
    fs = Dir()
    Loop
    End With
  Exit Sub
   
: errGet
  If Err.Number = 1004 Then
    For lJ = 1 To 5000 ' 讀取網頁失敗時, 等一段時間再重讀一次, 若連續5次失敗,則中止讀取.
      If lJ Mod 1000 = 0 Then OpenForms = DoEvents ' 每隔一段時間將控制權還給Windows處理其他程式的作業.
    Next
    iI = iI + 1
    If iI > 10 Then
      bStop = True
      MsgBox "讀取網頁失敗, 程式終止..."
      Exit Sub
    End If
    Resume
  Else
    Resume Next
  End If
End Sub

---

作者: spermbank    時間: 2013-11-17 01:20

回復 4# luhpro

     完全可以跑，不會有中斷現象，真是十分感謝^^

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)