Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


72502 / 76732 ←次へ | 前へ→

【8713】Re:VBAにてファイル内容比較
回答  ichinose  - 03/10/30(木) 1:41 -

引用なし
パスワード
   ▼カド さん:
こんばんは。
ちょっと時間が経ってしまったので、見てないかもしれませんが
作ってみました。見ていたら、確認してみて下さい。
標準モジュールに
'===============================================================
Sub main()
  Dim flnm
  If get_two_flnm(flnm) = True Then '二つの比較するファイル名を得る
    ans = file_comp(flnm)     'ファイルの中身の比較
    If ans = 0 Then
     判定 = "一致しました"
    ElseIf ans = 1 Then
     判定 = "一致しませんでした"
    Else
     判定 = "エラー発生のため判定できませんでした"
     End If
    MsgBox flnm(1) & " と" & vbLf & vbLf & flnm(2) & " は、" & vbLf & vbLf & 判定
    End If
End Sub
'===============================================================
Function get_two_flnm(flnm) As Boolean
'Output : flnm(1)とflnm(2)
  Dim file_array(1 To 2)
  Dim ans
  get_two_flnm = True
  MsgBox "ファイルを選択して下さい"
  For idx = 1 To 2
    ans = Application.GetOpenFilename()
    If ans <> False Then
     file_array(idx) = ans
     If idx = 1 Then MsgBox "比較するファイル指定して下さい"
    Else
     get_two_flnm = False
     Exit For
     End If
    Next idx
  If get_two_flnm = True Then
    flnm = file_array()
    End If
End Function
'===============================================================
Function file_comp(flnm) As Long
'input :flnm(1) flnm(2)
  Dim buf As String
  Dim bt1() As Byte
  Dim bt2() As Byte
  Dim flio1 As binio
  Dim flio2 As binio
  Dim flsz1 As Long
  Dim flsz2 As Long
  Dim f_offset1 As Long
  Dim f_offset2 As Long
  file_comp = 0
  Set flio1 = New binio
  Set flio2 = New binio
  If flio1.open_fl(flnm(1), 1024, flsz1) = 0 And _
       flio2.open_fl(flnm(2), 1024, flsz2) = 0 Then
    If flsz1 = flsz2 Then
     Do While flio1.get_fl(bt1(), f_offset1) = 0 And _
         flio2.get_fl(bt2(), f_offset2) = 0
       For idx = LBound(bt1()) To UBound(bt1())
        If bt1(idx) <> bt2(idx) Then
          file_comp = 1
          End If
        Next idx
       Loop
    Else
     file_comp = 1
     End If
  Else
    file_comp = 2
    End If
  flio1.cls_fl
  flio2.cls_fl
  Set flio1 = Nothing
  Set flio2 = Nothing
End Function

それからクラスモジュール(クラス名はbinioにしました)に、
'===============================================================
Private flno As Long
Private restsz As Long
Private buffer As Long
'===============================================================
Function open_fl(flnm, buffzs As Long, flsize As Long) As Long
  On Error Resume Next
  flno = FreeFile()
  Open flnm For Binary As #flno
  open_fl = Err.Number
  If open_fl = 0 Then
    restsz = LOF(flno)
    buffer = buffzs
    flsize = restsz
    End If
  On Error GoTo 0
End Function
'===============================================================
Sub cls_fl()
  On Error Resume Next
  Close #flno
  On Error GoTo 0
End Sub
'===============================================================
Function get_fl(bt() As Byte, g_idx As Long) As Long
'               ↑は、ここでは使ってないけどあると便利そうだから
  On Error Resume Next
  Dim readbyte As Long
  If restsz <= 0 Then
    get_fl = 1
  Else
    If restsz >= buffer Then
     readbyte = buffer - 1
    Else
     readbyte = restsz - 1
     End If
    g_idx = Loc(flno)
    ReDim bt(readbyte)
    Get #flno, , bt()
    get_fl = Err.Number
    If get_fl = 0 Then
     restsz = restsz - readbyte - 1
     End If
    End If
  On Error GoTo 0
End Function

何回かテストしましたが、それらしく動いていました。
0 hits

【8646】VBAにてファイル内容比較 カド 03/10/28(火) 12:29 質問
【8652】Re:VBAにてファイル内容比較 INA 03/10/28(火) 14:41 回答
【8654】Re:VBAにてファイル内容比較 カド 03/10/28(火) 14:47 お礼
【8658】Re:VBAにてファイル内容比較 INA 03/10/28(火) 14:51 回答
【8667】Re:VBAにてファイル内容比較 カド 03/10/28(火) 16:28 発言
【8669】Re:VBAにてファイル内容比較 INA 03/10/28(火) 16:46 回答
【8677】Re:VBAにてファイル内容比較 カド 03/10/29(水) 7:09 お礼
【8678】Re:VBAにてファイル内容比較 INA 03/10/29(水) 8:41 回答
【8713】Re:VBAにてファイル内容比較 ichinose 03/10/30(木) 1:41 回答
【8752】Re:VBAにてファイル内容比較 カド 03/10/31(金) 8:49 お礼

72502 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free