office交流網(wǎng)--QQ交流群號(hào)及微信交流群

Access培訓(xùn)群:792054000         Excel免費(fèi)交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

微信交流群(請(qǐng)用微信掃碼)

        

把整箇Access數(shù)據(jù)庫(kù)所有對(duì)象寫(xiě)到一箇文本文件

2017-09-12 08:05:00
Arvin Meyer
轉(zhuǎn)貼
3292

使用微軟未公開(kāi)的函數(shù) Application.SaveAsText 將整箇Access數(shù)據(jù)庫(kù)所有對(duì)象包括窗體 報(bào)錶  宏 查詢 模塊等的內(nèi)容及定義寫(xiě)到文本文件中去

相當(dāng)於對(duì)整箇Access數(shù)據(jù)庫(kù)做一箇完整的程序備份(不含數(shù)據(jù)庫(kù)內(nèi)容)




Public Sub DocDatabase()
 '====================================================================
 ' Name:    DocDatabase
 ' Purpose: Documents the database to a series of text files
 '
 ' Author:  Arvin Meyer
 ' Date:    June 02, 1999
 ' Comment: Uses the undocumented [Application.SaveAsText] syntax
 '        	To reload use the syntax [Application.LoadFromText] 
 '		Modified to set a reference to DAO 8/22/2005
 '====================================================================
On Error GoTo Err_DocDatabase
Dim dbs As DAO.Database
Dim cnt As DAO.Container
Dim doc As DAO.Document
Dim i As Integer

Set dbs = CurrentDb() ' use CurrentDb() to refresh Collections

Set cnt = dbs.Containers("Forms")
For Each doc In cnt.Documents
    Application.SaveAsText acForm, doc.Name, "D:\Document" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Reports")
For Each doc In cnt.Documents
    Application.SaveAsText acReport, doc.Name, "D:\Document" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Scripts")
For Each doc In cnt.Documents
    Application.SaveAsText acMacro, doc.Name, "D:\Document" & doc.Name & ".txt"
Next doc

Set cnt = dbs.Containers("Modules")
For Each doc In cnt.Documents
    Application.SaveAsText acModule, doc.Name, "D:\Document" & doc.Name & ".txt"
Next doc

For i = 0 To dbs.QueryDefs.Count - 1
    Application.SaveAsText acQuery, dbs.QueryDefs(i).Name, "D:\Document" & dbs.QueryDefs(i).Name & ".txt"
Next i

Set doc = Nothing
Set cnt = Nothing
Set dbs = Nothing

Exit_DocDatabase:
    Exit Sub


Err_DocDatabase:
    Select Case Err

    Case Else
        MsgBox Err.Description
        Resume Exit_DocDatabase
    End Select

End Sub
分享
文章分類
聯(lián)繫我們
聯(lián)繫人: 王先生
Email: 18449932@qq.com
QQ: 18449932
微博: officecn01
移動(dòng)訪問(wèn)