office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

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

把整個Access數據庫所有對象寫到一個文本文件

2017-09-12 08:05:00
Arvin Meyer
轉貼
1031

使用微軟未公開的函數 Application.SaveAsText 將整個Access數據庫所有對象包括窗體 報表  宏 查詢 模塊等的內容及定義寫到文本文件中去

相當于對整個Access數據庫做一個完整的程序備份(不含數據庫內容)




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
分享
北京十一选五基本走势