ExcelVBA ThisWorkbook.RefleshAllで更新待ちしてくれない対策

サンプル。指定シートの更新を行ってから待つ

クラス CQtEvents

Option Explicit

Private WithEvents mQryTble As QueryTable
Private mRefreshed As Boolean
Private mCallback As String

Public Property Set QryTble(ByVal QryTable As QueryTable): Set mQryTble = QryTable: End Property
Public Property Get QryTble() As QueryTable: Set QryTble = mQryTble: End Property

Public Property Let Refreshed(ByVal paramRefreshed As Boolean): mRefreshed = paramRefreshed: End Property
Public Property Get Refreshed() As Boolean: Refreshed = mRefreshed: End Property

Public Property Let Callback(ByVal SpecifiedProcName): mCallback = SpecifiedProcName: End Property

Private Sub Class_Initialize()
    mRefreshed = False
End Sub

Private Sub mQryTble_BeforeRefresh(Cancel As Boolean)
    mRefreshed = False
    Debug.Print "*** mQryTble_BeforeRefresh(): Refreshed=" & Refreshed
End Sub

Private Sub mQryTble_AfterRefresh(ByVal Success As Boolean)
    mRefreshed = True
    Debug.Print "*** mQryTble_AfterRefresh(): Refreshed=" & Refreshed, "Success=" & Success
    If mCallback <> "" Then Application.Run mCallback, Success
End Sub

メインコード

    Dim TargetTable As ListObject: Set TargetTable = Sheets("hogehoge").ListObjects(1)
    TargetTable.DataBodyRange.Rows.Delete ' いったんテーブルのデータを全てクリア
    
    Dim TargetQueryTable As QueryTable: Set TargetQueryTable = TargetTable.QueryTable
    Dim classQtEvents As CQtEvents: Set classQtEvents = New CQtEvents
    Set classQtEvents.QryTble = TargetQueryTable
    
    Dim BeforeTime: BeforeTime = Timer
    Debug.Print "[Before] TargetQueryTable.Refreshing:" & TargetQueryTable.Refreshing, "Rows.Count: " & TargetTable.Range.Rows.Count
    
    classQtEvents.QryTble.Refresh BackgroundQuery:=False ' クエリ更新を待つ
    
    'Debug.Print "[After]  TargetQueryTable.Refreshing:" & TargetQueryTable.Refreshing, "Rows.Count: " & TargetTable.Range.Rows.Count
    'Debug.Print "[Completed] " & Format(Timer - BeforeTime, "00:00:00.000")

ネタ元

gist.github.com

ExcelVBAでテキストファイルを比較 

'テキストファイルの比較
'同じならTrue / 違うなら False
Function DiffTxtFile(aFilepath1 As String, aFilepath2 As String) As Boolean

    DiffTxtFile = True
    
    ' 機能：２つのテキストファイルを比較する
    ' 【変数定義】
    Dim file1(1) As String ' ファイル名（フルパス）
    Dim file2(1) As String ' ファイル名
    Dim nFNO(1) As Integer 'ファイル番号
    Dim buf(1) As String ' テキスト読み出し用バッファ
    Dim line_no(1) As Integer ' 行数
    Dim str1 As String ' 文字列
    Dim i As Integer ' 整数
    ' ファイル名
    file1(0) = aFilepath1 ' テキストファイル１のファイル名（フルパス）
    file1(1) = aFilepath2 ' テキストファイル２のファイル名（フルパス）
    ' ファイルが存在するか確認
    For i = 0 To 1
      If Dir(file1(i)) = "" Then
        MsgBox i & ": " & file1(i) & "が存在しません。"
        Exit Function
      End If
    Next
    For i = 0 To 1
      ' 使用可能なファイル番号を調べる
      nFNO(i) = FreeFile()
      ' ファイルを開く
      Open file1(i) For Input As #nFNO(i)
      ' 行数を初期化
      line_no(i) = 0
      ' ファイル名から、パスを除く
      file2(i) = Dir(file1(i))
    Next
    ' どちらかのファイルがEOFになるまで繰り返す
    Do Until EOF(nFNO(0)) Or EOF(nFNO(1))
      For i = 0 To 1
        Line Input #nFNO(i), buf(i) ' １行ずつ読み出す
        line_no(i) = line_no(i) + 1 ' 行番号を１増やす
        ' １行ずつ比較
        If i = 1 And StrComp(buf(0), buf(1), vbTextCompare) <> 0 Then
           DiffTxtFile = False
          MsgBox line_no(0) & "行目が異なります。" & vbCrLf _
          & file2(0) & "=" & buf(0) & vbCrLf _
          & file2(1) & "=" & buf(1)
           GoTo label_escape
        End If
      Next
    Loop
    ' 行数が異なるか？
    If EOF(nFNO(0)) <> EOF(nFNO(1)) Then
      For i = 0 To 1
        If EOF(nFNO(i)) = False Then
          Do Until EOF(nFNO(i))
            Line Input #nFNO(i), buf(i) ' １行ずつ読み出す
            line_no(i) = line_no(i) + 1 ' 行番号を１増やす
          Loop
        End If
      Next
      DiffTxtFile = False
      MsgBox "行数が異なります。" & vbCrLf _
      & file2(0) & "=" & line_no(0) & vbCrLf _
      & file2(1) & "=" & line_no(1)
      GoTo label_escape
    End If
    
label_escape:
    ' ファイルを閉じる
    For i = 0 To 1
        Close #nFNO(i)
    Next
End Function

ネタ元

cheese999.blog.ss-blog.jp