窗体数据不能及时刷新

代码如下：

Private Sub Command0_Click()

 con.Open "provider=microsoft.ace.oledb.12.0;data source=" & "G:\¸öèË×êÔ′\êy¾Y¿a\data.accdb"
 Set xlapp = CreateObject("excel.application")
 xlapp.Workbooks.Open FileName:="G:\¸öèË×êÔ′\êy¾Y¿a\êy¾Y¿aÄ￡°å\3öèë¿aÄ￡°å.xlsx" 'Õa¾äêÇ′ò¿aÎļt
 'activeworkbook.Visible = False
 arr = Range("A1").CurrentRegion
 Dim sql As String
    Dim i As Integer, j As Integer
    For i = 2 To UBound(arr)
       sql = "insert into [3öèë¿a±í] values(" & i - 1 & ",'" & arr(i, 2) & "','" & arr(i, 3) & "','" & arr(i, 4) & "','" & arr(i, 5) & "','" & arr(i, 6) & "')"
       con.Execute sql
       '
    Next i
  'con.CommitTrans
  Me.Refresh
  Me.3öèë¿a±í_×ó′°ìå.Requery
  MsgBox "êy¾Yμ¼èëíê±Ï¡￡", vbInformation, "ìáê¾"
  Set con = Nothing
End Sub