Access VBA オブジェクト名を取得して名前を変更する

Option Compare Database

Sub GetTableName()
    Dim mymydb  As Database
    
    Set mydb = CurrentDb
    
    Debug.Print "スタート"
    
    'テーブル名を取得して変更
    For Each mytbl In mydb.TableDefs
        If Not Left(mytbl.Name, 4) = "MSys" Then
            Dim TName As String
            TName = mytbl.Name
            
            'DoCmd.Rename fKanaHan2Zen(mytbl.Name), acTable, TName
    
            Debug.Print fKanaHan2Zen(mytbl.Name) & "|" & TName
        End If
        
    Next
    
    'クエリ名を取得して変更
    For Each mytbl In mydb.QueryDefs
        If Not Left(mytbl.Name, 4) = "MSys" Then
            Dim QName As String
            QName = mytbl.Name
            
            'DoCmd.Rename fKanaHan2Zen(mytbl.Name), acQuery, QName
    
            Debug.Print fKanaHan2Zen(mytbl.Name) & "|" & QName
        End If
    Next
    
    'フォーム名を取得して変更
    Set ctn = mydb.Containers!Forms
    For Each mytbl In ctn.Documents
        If Not Left(mytbl.Name, 4) = "MSys" Then
            Dim FName As String
            FName = mytbl.Name
            
            'DoCmd.Rename fKanaHan2Zen(mytbl.Name), acForm, FName
    
            Debug.Print fKanaHan2Zen(mytbl.Name) & "|" & FName
        End If
    Next
    
    'マクロ名を取得して変更
    Set ctn = mydb.Containers!Scripts
    For Each mytbl In ctn.Documents
        If Not Left(mytbl.Name, 4) = "MSys" Then
            Dim MName As String
            MName = mytbl.Name
            
            'DoCmd.Rename fKanaHan2Zen(mytbl.Name), acMacro, MName
    
            Debug.Print fKanaHan2Zen(mytbl.Name) & "|" & MName
        End If
    Next
    
    'モジュール名を取得して変更
    Set ctn = mydb.Containers!Modules
    For Each mytbl In ctn.Documents
        If Not Left(mytbl.Name, 4) = "MSys" Then
            Dim MoName As String
            MoName = mytbl.Name
            
            'DoCmd.Rename fKanaHan2Zen(mytbl.Name), acModule, MoName
    
            Debug.Print fKanaHan2Zen(mytbl.Name) & "|" & MoName
        End If
    Next
    
    
    
    Debug.Print "エンド"
    
End Sub
Function fKanaHan2Zen(ByRef myString As String) _
                                      As String
    Dim i       As Long
    Dim strTemp As String
    Dim strKana As String
    Dim chrKana As String

    For i = 1& To Len(myString)
        chrKana = Mid$(myString, i, 1&)
        Select Case Asc(chrKana)
            Case 166 To 223
                '半角が続いたら文字をつなぐ
                strKana = strKana & chrKana
            Case Else
            '全角文字になったら半角の未処理文字を全部全角
            'に変換これにより濁点処理等が不要
                If Len(strKana) > 0& Then
                    strTemp = strTemp & StrConv(strKana, vbWide)
                    strKana = vbNullString
                End If
                strTemp = strTemp & chrKana
        End Select
    Next i
    '最後の文字が半角の場合の処理
    If Len(strKana) > 0& Then
        strTemp = strTemp & StrConv(strKana, vbWide)
    End If
    fKanaHan2Zen = strTemp
End Function