上一篇我們提到使用VBA來備份與還原物件，這一篇來點不同的作法，將整個MDB檔案備份，這部份牽扯到了單純備份MDB檔案，還是將外部資料庫的資料表也複製到MDB中，由於筆者有此需求，所以另外撰寫了這個選項，讓程式執行備份時，轉出近期資料於備份的MDB檔中，讓該MDB檔案，包含了近期的資料，可以用於非公司內部網路的使用者，查詢到近期資料。
當然，除了提供資料給同仁參考外，也可以當作備份的一種方式，外部SQL Server的資料，並不保證不出問題，若之後有出問題，手邊還有另一備份可以使用，會更有保障。
另外，壓縮的部份，筆者選用WinRAR來進行壓縮，若有朋友喜歡用7z的，也可以試著製作相關的子程式使用，筆者這邊會用到Day15提到的WinRAR壓縮子程式處理壓縮程序。
MDB檔案的保存，還有另一個需要注意的，由於操作Access來產資料時，有時候會造成MDB檔案日益肥大，雖然可以由「工具」->「資料庫公用程式」->「壓縮與修復資料庫」的功能，壓縮與修復MDB檔案，但如果可以透過VBA來操作，將會更簡便：
這裡我先列出此子程式，因為後面程式會運用到：
Sub MDB_CompactAndRepair(strSourceDB As String, _
Optional strPassword As String = "", _
Optional bnDoRARBackup As Boolean = False _
)
'Compact and repair the MDB file.
'strSourceDB 來源資料
'strPassword MDB密碼
'bnDoRARBackup 是否先以RAR備份
Set oEngine = CreateObject("JRO.JetEngine")
Dim strDestDB As String, strBackDB As String
strDestDB = strSourceDB & "_new.mdb"
strBackDB = strSourceDB & ".rar"
oEngine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strSourceDB & ";" & _
"Jet OLEDB:Database Password=" & strPassword & ";", _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=5;" & _
"Data Source=" & strDestDB & ";" & _
"Jet OLEDB:Database Password=" & strPassword & ";"
If bnDoRARBackup = True Then
Call WinRAR("m", strBackDB, strSourceDB, "", "")
Else
Kill strSourceDB
End If
Name strDestDB As strSourceDB
End Sub
此程式可以壓縮本身MDB檔案以外的MDB檔，所以如果要壓縮本身的MDB檔，還是須透過功能選項來壓縮，但可喜的是，我們要轉出資料給user用，或者轉出資料來備份，這就是本身以外的MDB檔，即可透過此程式來處理。
以下程式為轉出MDB檔案的主程式：
Function ExpMDBData(Optional bnSilence As Boolean = False, _
Optional strDestFullPathFileName As String = "", _
Optional strWinRAR2ServerPath As String = "", _
Optional bnShowResult As Boolean = True, _
Optional bnExpTableData As Boolean = True, _
Optional strRARFileName As String = "MDBS-Data.rar", _
Optional bnDeleteSecretData As Boolean = True, _
Optional dateWorkMonth As Date = "1990/1/1", _
Optional dateWorkMonthStart As Date, _
Optional dateWorkMonthEnd As Date, _
Optional strRARFileSaveLocal As String = "D:\MDBS_Backup", _
Optional strRARFileSaveNameLocal As String = "MDBS-Data", _
Optional bnMDBCompactAndRepair As Boolean = True _
)
'bnSilence 安靜模式，不秀出任何訊息
'strDestFullPathFileName 目的地完整路徑與檔名
'strWinRAR2ServerPath 使用WinRAR備份的目的地路徑(有填寫此項目,才會進行壓縮)
'bnShowResult 顯示結果
'bnExpTableData 是否匯出外部資料表
'strRARFileName WinRAR備份的檔名
'bnDeleteSecretData 刪除敏感資料
'dateWorkMonth 外部資料表指定匯出月份
'dateWorkMonthStart 外部資料表指定匯出月份起始
'dateWorkMonthEnd 外部資料表指定匯出月份結束
'strRARFileSaveLocal 本機壓縮檔存放路徑
'strRARFileSaveNameLocal 本機壓縮檔存放檔名
'bnMDBCompactAndRepair 是否執行MDB壓縮與修復
Dim strDateStamp As String, strCmd As String
Dim strSQL As String
'If Config("MasterPcName") <> Environ("COMPUTERNAME") Then Exit Sub
If bnSilence = False Then
If MsgBox("執行匯出備份？", vbOKCancel) <> vbOK Then Exit Function
End If
dateStart = Now
'若沒有指定路徑，則填入預設路徑
If strDestFullPathFileName = "" Then
strDestFullPathFileName = CurrentProject.path & "\" & CurrentProject.Name & "_Backup.mdb"
End If
'複製MDB檔到指定位置
Set fso = CreateObject("scripting.filesystemobject")
fso.CopyFile Source:=CurrentDb.Name, Destination:=strDestFullPathFileName
'是否刪除敏感資料
If bnDeleteSecretData = True Then
'清除電子郵件密碼
strSQL = "SELECT * FROM Config IN '" & strDestFullPathFileName & "' WHERE Name='e-mail_sendpassword'"
Set m = CurrentDb.OpenRecordset(strSQL)
m.Edit
m("Value") = ""
m.Update
''清除AS400資料表清單
strSQL = "DELETE * FROM AS400LIBFILEFFDH IN '" & strDestFullPathFileName & "'"
Call RunSQL(strSQL)
strSQL = "DELETE * FROM AS400LIBFILEFFDB IN '" & strDestFullPathFileName & "'"
Call RunSQL(strSQL)
'清除連線資料表描述
strSQL = "UPDATE ConnectTables IN '" & strDestFullPathFileName & "' SET DESCRIPTION = ''; "
Call RunSQL(strSQL)
End If
'如果需要轉出外部資料表(SQLServer)
If bnExpTableData = True Then
'看是否有設定起始與結束月份資料
'沒有的話進行設定
If CDbl(dateWorkMonthStart) > 0 And CDbl(dateWorkMonthStart) > 0 Then
ElseIf dateWorkMonth > "1990/1/1" Then
dateWorkMonthStart = DateAdd("d", (Day(dateWorkMonth) - 1) * -1, dateWorkMonth)
dateWorkMonthEnd = DateAdd("d", -1, DateAdd("m", 1, DateAdd("d", (Day(dateWorkMonth) - 1) * -1, dateWorkMonth)))
Else
dateWorkMonthStart = "1990/1/1"
dateWorkMonthEnd = "3000/1/1"
End If
strSQL = "SELECT * FROM ConnectTables WHERE ConnectTables.SERVER_TYPE='SQLServer'"
Set m = CurrentDb.OpenRecordset(strSQL)
If m.EOF = True Then Exit Function
Do
'如果有設定起始日期，則填入strWHERE字串中
strWHERE = ""
If dateWorkMonthStart <> "1990/1/1" Then
If m("EXP_DATE_RANGE") = 1 Then
strStart = Format(dateWorkMonthStart, "YYYYMMDD")
strEnd = Format(dateWorkMonthEnd, "YYYYMMDD")
strStartDate = Format(dateWorkMonthStart, "MM/DD/YYYY")
strEndDate = Format(dateWorkMonthEnd, "MM/DD/YYYY")
ElseIf IsNull(m("EXP_DATE_RANGE")) Then
strStart = "00000000"
strEnd = "99999999"
strStartDate = "1000/1/1"
strEndDate = "3000/1/1"
Else
dateWorkMonthStart2 = DateAdd("m", (m("EXP_DATE_RANGE") - 1) * -1, DateAdd("d", (Day(dateWorkMonth) - 1) * -1, dateWorkMonth))
strStart = Format(dateWorkMonthStart2, "YYYYMMDD")
strEnd = Format(dateWorkMonthEnd, "YYYYMMDD")
strStartDate = Format(dateWorkMonthStart2, "MM/DD/YYYY")
strEndDate = Format(dateWorkMonthEnd, "MM/DD/YYYY")
End If
If m("EXP_DATE_FIELD_TYPE") = "TEXT" Then
strWHERE = "WHERE " & m("EXP_DATE_FIELD") & " BETWEEN '" & strStart & "' AND '" & strEnd & "'"
ElseIf m("EXP_DATE_FIELD_TYPE") = "DATE" Then
strWHERE = "WHERE " & m("EXP_DATE_FIELD") & " BETWEEN #" & strStartDate & "# AND #" & strEndDate & "# "
ElseIf m("EXP_DATE_FIELD_TYPE") = "NUMBER" Then
strWHERE = "WHERE " & m("EXP_DATE_FIELD") & " BETWEEN " & strStart & " AND " & strEnd & " "
End If
End If
'如果有JOIN_STRING字串，則填入strJOIN
If m("JOIN_STRING") <> "" Or IsNull(m("JOIN_STRING")) = False Then
strJOIN = m("JOIN_STRING")
Else
strJOIN = ""
End If
strSQL = "SELECT * INTO " & m("LOCAL_TABLE") & " IN '" & strDestFullPathFileName & "' " & _
"FROM " & m("LOCAL_TABLE") & " " & strJOIN & " " & _
strWHERE & "; "
'strSQL = "SELECT * INTO " & M("LOCAL_TABLE") & " IN '" & strDestFullPathFileName & "' " & _
"FROM " & M("LOCAL_TABLE") & "; "
Call RunSQL(strSQL)
m.MoveNext
Loop Until m.EOF = True
End If
Set m = Nothing
'進行MDB壓縮
If bnMDBCompactAndRepair = True Then
Call MDB_CompactAndRepair(strDestFullPathFileName)
End If
'如果有WinRAR壓縮檔存放路徑，則建立壓縮檔
If Len(strWinRAR2ServerPath) > 0 Then
Dim strDes As String, strSrc As String
If Right(strWinRAR2ServerPath, 1) <> "\" Then strWinRAR2ServerPath = strWinRAR2ServerPath & "\"
strDateStamp = Format(Now, "yyyy-MM-dd-HHmmss")
strDes = strRARFileSaveLocal & "\" & strRARFileSaveNameLocal & "_" & strDateStamp & ".rar"
strSrc = strDestFullPathFileName
'先壓縮在本地磁碟機
Call WinRAR("a", strDes, strSrc, "", "")
'Sleep 10000
'然後再複製到指定位置
FileCopy strDes, strWinRAR2ServerPath & strRARFileName
End If
'計算作業時間
dateUse = Now - dateStart
If bnShowResult = True And Len(strWinRAR2ServerPath) > 0 Then
MsgBox "Done!" & vbCrLf & vbCrLf & _
"儲存檔案：" & strDestFullPathFileName & vbCrLf & _
"壓縮檔案：" & strWinRAR2ServerPath & strRARFileName & vbCrLf & _
"使用時間：" & Format(dateUse, "HH:MM:SS")
ElseIf bnShowResult = True Then
MsgBox "Done!" & vbCrLf & vbCrLf & vbCrLf & _
"儲存檔案：" & strDestFullPathFileName & vbCrLf & _
"使用時間：" & Format(dateUse, "HH:MM:SS")
End If
End Function
此程式中，運用了Access SQL的IN語法，讓SQL語句可以直接操控外部的MDB檔案，以此方式來清理敏感資料，讓user拿到時，是已經整理過的MDB檔案。
轉出外部資料表的部份，使用了Day28提到的ConnectTables資料表，裡面有記載外部資料轉出時，要抓取什麼範圍內的數據，以便轉出時僅部份新資料，避免MDB檔過大。
以此方式，可以保存最完整的MDB資料，而上篇則是透過轉出純文字檔，來達到批次修改與使用GitHub管理的效果，跟本篇的需求有所區隔。
物件轉移的部份，其實透過Access使用「匯入」方式直接操作會更便利，當然，轉成純文字檔後，有使用VBA操控的優勢，達到自動化的效果，這又是另一種思考邏輯了。
以下為測試程式：
Sub ExpMDBData測試()
Call ExpMDBData(False, CurrentProject.path & "\" & CurrentProject.Name & "_匯出測試.mdb", _
CurrentProject.path, True, False, CurrentProject.Name & ".rar", False, , , , Environ("TEMP"), "TEST")
End Sub
執行後，出現是否備份，按「確定」繼續：
完成後，會列出相關檔案與使用時間：
最後於資料夾內，可以找到相關檔案：
很快的，30天已經到來，筆者將近年所學分享出來，希望對有心學習的邦友們有所助益。
這30天整理手邊相關的程式碼，越整理，越覺得自己所學還是有所欠缺，透過這些時間的沈澱與精粹，越能知道自己的方向與目標，雖然Access年華已老，已跟不上時代的腳步，但其實會抓老鼠的貓就是好貓，能開闢山路的就是好刀，不需要用老虎來抓老鼠，也不需要推土機來開山路，這些程式老兵，在某些角落，還是有一片天的。
以下為此次有用到的相關程式碼與範例，有興趣者可以取回參考。
iThome鐵人賽
看影片追技術