iT邦幫忙

2017 iT 邦幫忙鐵人賽
DAY 29
0
自我挑戰組

Access VBA的眉眉角角系列 第 29 篇

Access VBA 的眉眉角角Day29: 物件的存取

2017鐵人賽
3996 瀏覽

  • 分享至 

  • xImage
    •  

當程式越開發越複雜時，如果要修改個多個VBA程式，可能涉及到表單上的程式與模組內的程式，也許還有報表上的程式需要調整，今日介紹一組程式，可將Access內的各種物件，匯出成純文字檔，以便再轉入其他Access檔案中使用，或以純文字檔批次修改後，再轉入原本Access中使用，如果要調整的關鍵字坐落於不同的物件中，這可以減少不少時間。

以下為物件轉純文字檔的程式：

Sub SaveAllObjectToText()
    Dim objForm As Object, objQuery As Object, objReport As Object
    Dim objDataAccessPage As Object, objMacro, objModule As Object
    Dim strPath As String
    Dim strExt As String
    Dim strPrev As String
    
    'application.saveastext acForm,"form name","c:filename.txt" 匯出表單成為純存字檔
    'application.loadfromtext acForm,"form name","c:filename.txt" 匯入純文字成表單
    
    strPath = "D:\temp\備份\"
    strMDBFileName = CurrentProject.Name
    strExt = ".txt"
    
    strPath = InputBox("備份路徑：", , strPath)
    If Len(strPath) = 0 Then
        MsgBox "備份路徑空白，取消匯出！"
        Exit Sub
    End If
    If FolderExist(strPath) = False Then
        Call MakeDir(strPath)
    End If
    
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    
    '查詢
    strPrev = "Query"
    For Each objQuery In CurrentData.AllQueries
        strFullPath = strPath & strMDBFileName & "_" & strPrev & "_" & objQuery.Name & strExt
        Debug.Print "轉出查詢：「" & objQuery.Name & "」到「" & strFullPath & "」"
        Application.SaveAsText acQuery, objQuery.Name, strFullPath
    Next
    
    '表單
    strPrev = "Form"
    For Each objForm In CurrentProject.AllForms
        strFullPath = strPath & strMDBFileName & "_" & strPrev & "_" & objForm.Name & strExt
        Debug.Print "轉出表單：「" & objForm.Name & "」到「" & strFullPath & "」"
        Application.SaveAsText acForm, objForm.Name, strFullPath
    Next
    
    '報表
    strPrev = "Report"
    For Each objReport In CurrentProject.AllReports
        strFullPath = strPath & strMDBFileName & "_" & strPrev & "_" & objReport.Name & strExt
        Debug.Print "轉出報表：「" & objReport.Name & "」到「" & strFullPath & "」"
        Application.SaveAsText acReport, objReport.Name, strFullPath
    Next
    
    '資料頁
    strPrev = "DataAccessPage"
    For Each objDataAccessPage In CurrentProject.AllDataAccessPages
        strFullPath = strPath & strMDBFileName & "_" & strPrev & "_" & objDataAccessPage.Name & strExt
        Debug.Print "轉出資料頁：「" & objDataAccessPage.Name & "」到「" & strFullPath & "」"
        Application.SaveAsText acDataAccessPage, objDataAccessPage.Name, strFullPath
    Next
    
    '巨集
    strPrev = "Macro"
    For Each objMacro In CurrentProject.AllMacros
        strFullPath = strPath & strMDBFileName & "_" & strPrev & "_" & objMacro.Name & strExt
        Debug.Print "轉出巨集：「" & objMacro.Name & "」到「" & strFullPath & "」"
        Application.SaveAsText acMacro, objMacro.Name, strFullPath
    Next
    
    '模組
    strPrev = "Module"
    For Each objModule In CurrentProject.AllModules
        strFullPath = strPath & strMDBFileName & "_" & strPrev & "_" & objModule.Name & strExt
        Debug.Print "轉出模組：「" & objModule.Name & "」到「" & strFullPath & "」"
        Application.SaveAsText acModule, objModule.Name, strFullPath
    Next
    
    MsgBox "完成！"
    
    Call OpenFolder2(strPath)


End Sub

以下為純文字檔轉物件的程式：

Sub LoadAllTextToObject()
    Dim strPath As String
    Dim strExt As String
    Dim strPrev As String
    Dim strFullPath As String
    Dim strObjName As String
    
    '類型：
    'acQuery '查詢
    'acForm '表單
    'acReport '報表
    'acDataAccessPage '資料頁
    'acMacro '巨集
    'acModule '模組
    
    strPath = "D:\temp\備份\"
    strMDBFileName = CurrentProject.Name
    strExt = ".txt"
    
    
    Dim fso As Object 'FileSystemObject
    Dim fld As Object 'Folder
    Dim fl As Object 'File
    Dim Mask As String
    
    Set fso = CreateObject("scripting.FileSystemObject")
    
    strPath = InputBox("請確認來源資料夾路徑：", , strPath)
    
    '如果沒有選擇的話則離開程式
    If Len(strPath) = 0 Then
        MsgBox "資料夾字串空白，停止匯入！"
        Exit Sub
    End If
    
    Set fld = fso.GetFolder(strPath)
    
    strMDBFileName = InputBox("請填入MDB檔名字串：", , strMDBFileName)
    If Len(strMDBFileName) = 0 Then
        MsgBox "MDB檔名字串空白，停止匯入！"
        Exit Sub
    End If
      
    MaskQuery = strMDBFileName & "_Query_" & "*" & strExt
    MaskForm = strMDBFileName & "_Form_" & "*" & strExt
    MaskReport = strMDBFileName & "_Report_" & "*" & strExt
    MaskDataAccessPage = strMDBFileName & "_DataAccessPage_" & "*" & strExt
    MaskMacro = strMDBFileName & "_Macro_" & "*" & strExt
    MaskModule = strMDBFileName & "_Module_" & "*" & strExt
    
    For Each fl In fld.Files
        If fl.Name Like MaskQuery Then
            strFullPath = fl.path
            strObjName = CutRight(CutLeft(strFullPath, strPath & strMDBFileName & "_Query_"), strExt)
            Application.LoadFromText acQuery, strObjName, strFullPath
            Debug.Print "轉入查詢：「" & strFullPath & "」到「" & strObjName & "」"
        End If
        If fl.Name Like MaskForm Then
            strFullPath = fl.path
            strObjName = CutRight(CutLeft(strFullPath, strPath & strMDBFileName & "_Form_"), strExt)
            Application.LoadFromText acForm, strObjName, strFullPath
            Debug.Print "轉入表單：「" & strFullPath & "」到「" & strObjName & "」"
        End If
        If fl.Name Like MaskReport Then
            strFullPath = fl.path
            strObjName = CutRight(CutLeft(strFullPath, strPath & strMDBFileName & "_Report_"), strExt)
            Application.LoadFromText acReport, strObjName, strFullPath
            Debug.Print "轉入報表：「" & strFullPath & "」到「" & strObjName & "」"
        End If
        If fl.Name Like MaskDataAccessPage Then
            strFullPath = fl.path
            strObjName = CutRight(CutLeft(strFullPath, strPath & strMDBFileName & "_DataAccessPage_"), strExt)
            Application.LoadFromText acDataAccessPage, strObjName, strFullPath
            Debug.Print "轉入資料頁：「" & strFullPath & "」到「" & strObjName & "」"
        End If
        If fl.Name Like MaskMacro Then
            strFullPath = fl.path
            strObjName = CutRight(CutLeft(strFullPath, strPath & strMDBFileName & "_Macro_"), strExt)
            Application.LoadFromText acMacro, strObjName, strFullPath
            Debug.Print "轉入巨集：「" & strFullPath & "」到「" & strObjName & "」"
        End If
        If fl.Name Like MaskModule Then
            strFullPath = fl.path
            strObjName = CutRight(CutLeft(strFullPath, strPath & strMDBFileName & "_Module_"), strExt)
            Application.LoadFromText acModule, strObjName, strFullPath
            Debug.Print "轉入模組：「" & strFullPath & "」到「" & strObjName & "」"
        End If
    Next

    MsgBox "完成！"
End Sub

程式中的Application.SaveAsText與Application.LoadFromText均為隱藏功能，由Access Help看不到這兩個方法的說明，自動完成功能也不會帶出這兩個方法，可見當時建立好方法後，因為某些原因，放棄了推廣此功能，不過好在這兩個方法運作正常，各位也可以透過以上提供的兩個程式來達成物件備份的需求。

執行SaveAllObjectToText後，會出現填寫備份路徑，可以依照自己的需求填寫路徑，如果路徑不存在，會自動建立，這個有用到Day11的MakeDir與FolderExist 子程式：
http://ithelp.ithome.com.tw/upload/images/20161228/20007221dYde8iPEyD.png

完成後，會使用Day11的OpenFolder2子程式來開啟資料夾：
http://ithelp.ithome.com.tw/upload/images/20161228/200072211de4WPhFzI.png

於即時運算視窗也可以看到轉出資料的相關資訊：
http://ithelp.ithome.com.tw/upload/images/20161228/20007221wBoQiq4BqB.png

而使用LoadAllTextToObject來匯入資料時，首先出現以下畫面，可以依照需求填寫路徑：
http://ithelp.ithome.com.tw/upload/images/20161228/20007221t3Ogf0hGOp.png

之後會確認要匯入的MDB檔案字串為何，如果匯入的來源為另一MDB檔的產生的純文字檔，則填入另一MDB的完整檔名：
http://ithelp.ithome.com.tw/upload/images/20161228/20007221O8LxNuTbO6.png

完成後，即時運算視窗會出現相關訊息：
http://ithelp.ithome.com.tw/upload/images/20161228/20007221EJAjVweDTD.png

筆者測試後發現，「資料頁」的部份有些問題，在轉入資料頁的純文字檔案後，資料頁內的捷徑會產生，但是原始存放.html的檔案，還是沒有辦法復原回來，而且執行到資料頁的部份時，會出現以下提示：
http://ithelp.ithome.com.tw/upload/images/20161228/20007221Jq4B41WgE5.png

執行後，會載入資料頁路徑，但完成後，不會繼續將其他的文字檔取回，這部份應該是微軟當時沒有完成的部份，而Access 2007後，也不繼續將資料頁功能放入，因此筆者建議不要使用此功能：

資料頁發生了什麼問題？

今天的介紹，讓Access的物件也能轉成純文字檔存放，如果有使用GitHub的，也可以透過此方式，將程式轉出後，使用GitHub儲存變更，未來也可以回朔相關程式。以上介紹，希望對各位有所幫助。


上一篇
Access VBA 的眉眉角角Day28: 連結外部ODBC資料表
下一篇
Access VBA 的眉眉角角Day30: MDB檔案備份
系列文
Access VBA的眉眉角角 共 30 篇
  1. 26
    Access VBA 的眉眉角角Day26: Windows認證與Active Directory認證
  2. 27
    Access VBA 的眉眉角角Day27: 連結外部Access檔案
  3. 28
    Access VBA 的眉眉角角Day28: 連結外部ODBC資料表
  4. 29
    Access VBA 的眉眉角角Day29: 物件的存取
  5. 30
    Access VBA 的眉眉角角Day30: MDB檔案備份
完整目錄
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

尚未有邦友留言

立即登入留言
iThome鐵人賽
參賽組數
1064 組
團體組數
40 組
累計文章數
22195 篇
完賽人數
600 人
iT+看影片追技術 看影片追技術 看更多
熱門tag 看更多
15th鐵人賽 16th鐵人賽 13th鐵人賽 14th鐵人賽 12th鐵人賽 11th鐵人賽 鐵人賽 2019鐵人賽 javascript 2018鐵人賽 python 2017鐵人賽 windows php c# windows server linux css react vue.js
熱門問題
熱門回答
熱門文章
IT邦幫忙