忍者ブログ
03 July

[PR]

×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

25 December

【Access/VBA】データベース上の全てのテーブルの特定のフィールドの特定の値を置換

自分用。
こんなモジュールに頼らないで済む設計が出来るようになってる筈だけども。


Option Compare Database
Option Explicit

' Write by m_o_co
Public Sub Do_Renzoku_KeyChg(KeyNam As String, DataStr As String, Optional Chg_Flg As Byte)
'========================
' 配列で受け取って投げる(雑設計)
'
' 0スタート、偶数番目がBefo_Data、続く奇数番目が、Chg_Data。
'========================

  Dim wkAry() As String
  Dim i As Long
  
  wkAry = Split(DataStr, ",")
  
  For i = 0 To UBound(wkAry) Step 2
  
    Debug.Print wkAry(i), "→", wkAry(i + 1)
    Call Do_KeyChg(KeyNam, wkAry(i), wkAry(i + 1), Chg_Flg)
    
  Next

End Sub


Public Sub Do_KeyChg(KeyName As String, Befo_Data As Variant, Chg_Data As Variant, Optional Chg_Flg As Byte)
'========================
' テーブル構成情報収集依存
'
' Chg_Flg … Chg_Dataが既に置換前から存在していた場合
'     … 1 エラーとせず、そのまま置換する
'     … 0 エラーとして、中断する
'     … 2 チェックのみで、置換しない
'========================
Dim DB As DAO.Database, RS As DAO.Recordset
Dim tgTBLn() As String, i As Long, j As Long
Dim wkFlg As Boolean, wkPceSQL As String
Dim Jump_Flg As Integer, wkStr As String

    
  If Chg_Flg = 2 Then wkFlg = True

  Set DB = CurrentDb()
  Set RS = DB.OpenRecordset("Select テーブル名 from テーブル構成情報収集 Where 項目名='" & KeyName & "'", dbOpenSnapshot)
  
  If Not RS.EOF Then
    
    ' テーブル名収集
    RS.MoveLast
    ReDim tgTBLn(RS.RecordCount - 1)
    
    i = 0
    RS.MoveFirst
    Do Until RS.EOF
      tgTBLn(i) = RS!テーブル名
      RS.MoveNext
      i = i + 1
    Loop
    
    RS.Close
  
  
    Debug.Print _
    "-----------------------------------------------------" & vbCrLf & _
    "     結果コードの現存確認" & vbCrLf & _
    "-----------------------------------------------------"
    
    Select Case TypeName(Chg_Data)
    Case "String"
      wkPceSQL = "'★_☆'"
    Case "Integer", "Double", "Boolean"
      wkPceSQL = "★_☆"
    End Select
    
    Jump_Flg = 1
    On Error GoTo Err_Me
        
    
    For i = 0 To UBound(tgTBLn)
      Set RS = DB.OpenRecordset("Select * from " & tgTBLn(i) & " Where " & KeyName & "=" & Replace(wkPceSQL, "★_☆", Chg_Data), dbOpenSnapshot)
      
      If Not RS.EOF Then
      
        If Chg_Flg = 0 Then wkFlg = True
      
        RS.MoveLast
        Debug.Print "-------- " & tgTBLn(i) & " " & RS.RecordCount & "件 --------"
        RS.MoveFirst
        
        '   フィールド名を作成→出力
        wkStr = ""
        For j = 0 To RS.Fields.Count - 1
          If wkStr <> "" Then wkStr = wkStr & ","
          wkStr = wkStr & RS.Fields(j).Name
        Next
        Debug.Print wkStr
        
        '   レコードの内容を出力
        wkStr = ""
        Do Until RS.EOF
          For j = 0 To RS.Fields.Count - 1
            If wkStr <> "" Then wkStr = wkStr & ","
            wkStr = wkStr & RS(j)
          Next
          Debug.Print wkStr
          wkStr = ""
          
          RS.MoveNext
        Loop
  
      End If
      
Go_Next_Table_1:
    Next
    
    Jump_Flg = 2
    
    Debug.Print "-------- 結果コードの現存確認 終了 --------"
    
    Debug.Print _
    "-----------------------------------------------------" & vbCrLf & _
    "     対象コードの現状確認" & vbCrLf & _
    "-----------------------------------------------------"
    
    For i = 0 To UBound(tgTBLn)
      Set RS = DB.OpenRecordset("Select * from " & tgTBLn(i) & " Where " & KeyName & "=" & Replace(wkPceSQL, "★_☆", Befo_Data), dbOpenSnapshot)
      
      If Not RS.EOF Then
        RS.MoveLast
        Debug.Print "-------- " & tgTBLn(i) & " " & RS.RecordCount & "件 --------"
        RS.MoveFirst
        
        wkStr = ""
        For j = 0 To RS.Fields.Count - 1
          If wkStr <> "" Then wkStr = wkStr & ","
          wkStr = wkStr & RS.Fields(j).Name
        Next
        Debug.Print wkStr
        
        wkStr = ""
        Do Until RS.EOF
          For j = 0 To RS.Fields.Count - 1
            If wkStr <> "" Then wkStr = wkStr & ","
            wkStr = wkStr & RS(j)
          Next
          Debug.Print wkStr
          wkStr = ""
          
          RS.MoveNext
        Loop
  
      End If
      
Go_Next_Table_2:
    Next
    
    Jump_Flg = 3
      
    Debug.Print "-------- 対象コードの現状確認 終了 --------"
    
    If Not wkFlg Then
      Debug.Print _
      "-----------------------------------------------------" & vbCrLf & _
      "     置換開始" & vbCrLf & _
      "-----------------------------------------------------"
      
      For i = 0 To UBound(tgTBLn)
        DB.Execute "Update " & tgTBLn(i) & " Set " & KeyName & "=" & Replace(wkPceSQL, "★_☆", Chg_Data) & " Where " & KeyName & "=" & Replace(wkPceSQL, "★_☆", Befo_Data)
Go_Next_Table_3:
      Next
      
        Jump_Flg = 4
    
      Debug.Print "-------- 終了 --------"
      
    Else
      
      Select Case Chg_Flg
      Case 0:      Debug.Print "-------- 現存あり、置換せず終了 --------"
      Case 2:      Debug.Print "-------- チェック 終了 --------"
      End Select
      
    End If
    
  Else
  
    Debug.Print "-------- " & KeyName & " フィールド、対象テーブルなし --------"
    RS.Close
    
  End If
  
  DB.Close


Exit Sub
Err_Me:

  Select Case Err.Number
  Case 3078
    Resume Go_Next_Table
  Case 3061
    If Sgn(tgTBLn) <> 0 And InStr(Err.Description, "1") > 0 Then
      Debug.Print "--------【Skip】 " & tgTBLn(i) & " ターゲットフィールドなし --------"
      Resume Go_Next_Table
    Else
      GoTo Other_Err
    End If
  
  Case Else
  
Other_Err:
    Debug.Print Err.Number & Err.Description & " Jump_Flg = " & Jump_Flg
    
  End Select

Exit Sub
Go_Next_Table:

  Select Case Jump_Flg
  Case 1: GoTo Go_Next_Table_1
  Case 2: GoTo Go_Next_Table_2
  Case 3: GoTo Go_Next_Table_3
  Case Else: GoTo Other_Err
  End Select

End Sub

拍手

PR