Access 窗体进度条刷新

Esowei_001

一个Access 窗体 vba 在界面加了个进度条。程序执行导入关联到进度条，点击导入按钮后进度条会Repaint，但是一旦在程序执行导入过程中，切换到其他程序后，然后再返回到Access界面，access窗体的进度条就不刷新了，如何解决这个问题？
DoEvents 挂起应该能解决这个问题，但是大数据量导入就会导致导入时间过长...

With Form_EtoAForm.ProgressBar3
        .Min = 0
        .Max = rs.RecordCount
        For j = 1 To rs.RecordCount
        If rs.EOF = True Then
            MsgBox "选择的工作表数据不是合法的数据！请检查！", vbExclamation, "非法数据"
        Exit Sub
        Else
        rs1.AddNew
        '--------------------数据集为空即为非法数据表选择-----------------------------------
            For i = 1 To rs.Fields.Count
                                
                Select Case i
                Case 1
                rs1.Fields(i) = Year(Now) '年份
                Case 2
                rs1.Fields(i) = Combo52.Value '月份
                Case 52
                If  Lcase(rs.Fields(i - 1).Value) =  "close" Then
                rs1.Fields(i) = 0
                Else
                rs1.Fields(i) = 1
                End If
                            '-------------------Close字段导入数据库----------------------------
                Case Else
                rs1.Fields(i) = RTrim(rs.Fields(i - 1))
                Debug.Print j, i, rs.Fields(i - 1).Value
                End Select
            Next i
        rs1.Update
        rs.MoveNext
        End If
            '-------------------------执行导入Excel到SQL---------------------------------
                Form_EtoAForm.ProgressBar3.Value = j
            If j / rs.RecordCount = 1 Then
                Label67.Caption = "已完成" & Int(j / rs.RecordCount * 100) & "%, 数据已经导入完毕!"
            Else
                Label67.Caption = "已完成" & Round(j / rs.RecordCount * 100, 2) & "%, 請稍候!......"
                Form_EtoAForm.Repaint
            End If
             '-------------------------数据导入进度百分比(考虑大量数据导入，精确到小数点后2位)---------------------------------
        Next j
End With