» Poradna » Programy

VBA - MS Access - export názvů objektů

 |   |  Microsoft Windows 7 Firefox 19.0

Zdravím, obracím se na Vás s následující prosbou. Mám databázi v MS Access 2007, která obsahuje asi 30 tabulek, 80 dotazů, 30 sestav a stejné množství formulářů. Pak tam mám pár maker a modulů. Ráda bych názvy všech objektů v databázi (tabulek, dotazů, formulářů, sestav, maker i modulů) "exportovala" do textového souboru např. MS Word. Na internetu jsem si našla kód, který zobrazí názvy objeků, ale umí je ukázat jako message box v MS Access, což je mi k ničemu. Neznáte, někdo, prosím, způsob, jak exportovat názvy objedků databáze do textového souboru, případně umíte někdo upravit kód tak, aby místo do Msg box exportoval názvy objektů? Díky mocKód (myslím, že stačí upravit pouze case7, ostatní exportují vždy jen jeden typ objektů):Private Sub ChooseObject_AfterUpdate() Dim DB As Database, I As Integer, j As Integer, ok_cancel As Integer Dim System_Prefix, Current_TableName, Hidden_Prefix Dim Ok As Integer, Cancel As Integer Ok = 1 Cancel = 2 Set DB = DBEngine(0)(0) Select Case Me![ChooseObject] Case 1 'System tables are excluded from the list. For I = 0 To DB.TableDefs.Count - 1 Current_TableName = DB.TableDefs(I).Name System_Prefix = Left(Current_TableName, 4) Hidden_Prefix = Left(Current_TableName, 1) If System_Prefix <> "MSys" And System_Prefix <> "USys" And Hidden_Prefix <> "~" Then ok_cancel = MsgBox(DB.TableDefs(I).Name, 65, "TABLE NAMES") If ok_cancel = Cancel Then Exit Sub End If End If Next I Case 2 For I = 0 To DB.QueryDefs.Count - 1 ok_cancel = MsgBox(DB.QueryDefs(I).Name, 65, "QUERY NAMES") If ok_cancel = Cancel Then Exit Sub End If Next I Case 3 For I = 0 To DB.Containers("Forms").Documents.Count - 1 ok_cancel = MsgBox(DB.Containers("Forms").Documents(I).Name, 65, "FORM NAMES") If ok_cancel = Cancel Then Exit Sub End If Next I Case 4 For I = 0 To DB.Containers("Reports").Documents.Count - 1 ok_cancel = MsgBox(DB.Containers("Reports").Documents(I).Name, 65, "REPORT NAMES") If ok_cancel = Cancel Then Exit Sub End If Next I Case 5 'Scripts are macros. For I = 0 To DB.Containers("Scripts").Documents.Count - 1 ok_cancel = MsgBox(DB.Containers("Scripts").Documents(I).Name, 65, "MACRO NAMES") If ok_cancel = Cancel Then Exit Sub End If Next I Case 6 For I = 0 To DB.Containers("Modules").Documents.Count - 1 ok_cancel = MsgBox(DB.Containers("Modules").Documents(I).Name, 65, "MODULE NAMES") If ok_cancel = Cancel Then Exit Sub End If Next I Case 7 For I = 0 To DB.Containers.Count - 1 For j = 0 To DB.Containers(I).Documents.Count - 1 ok_cancel = MsgBox(DB.Containers(I).Name & Chr(13) & Chr(10) & DB.Containers(I).Documents(j).Name, 65, "ALL OBJECTS") If ok_cancel = Cancel Then Exit Sub End If Next j Next I End Select End Sub

Odpovědi na otázku

 |   |  Microsoft Windows Vista Opera 9.80

Ten Case 7 se dá upravit třeba takto (je to nová procedura a vytvoří soubor ObjectNames.txt ve stejném adresáři jako je databáze):Sub ObjectNames()Dim db As Database, i As Integer, j As IntegerDim fnum Set db = DBEngine(0)(0) fnum = FreeFile Open CurrentProject.Path & "\ObjectNames.txt" For Output As #fnum For i = 0 To db.Containers.Count - 1 For j = 0 To db.Containers(i).Documents.Count - 1 Print #fnum, db.Containers(i).Name & vbTab & db.Containers(i).Documents(j).Name Next j Next i Close #fnumEnd SubCo jsem ale koukal, tak nerozlišuje mezi tabulkou a dotazem. Můžeš tedy vyzkoušet i tohle:Sub ObjectNames() Dim db As Database Dim td As TableDef Dim doc As Document Dim i As Integer Dim fnum Set db = CurrentDb() fnum = FreeFile Open CurrentProject.Path & "\ObjectNames.txt" For Output As #fnum For Each td In db.TableDefs If Left(td.Name, 4) <> "MSys" Then Print #fnum, "Tables" & vbTab & td.Name End If Next td For i = 0 To db.QueryDefs.Count - 1 Print #fnum, "Queries" & vbTab & db.QueryDefs(i).Name Next i For Each doc In db.Containers("Forms").Documents Print #fnum, "Forms" & vbTab & doc.Name Next doc For Each doc In db.Containers("Reports").Documents Print #fnum, "Reports" & vbTab & doc.Name Next doc For Each doc In db.Containers("Scripts").Documents Print #fnum, "Macros" & vbTab & doc.Name Next doc For Each doc In db.Containers("Modules").Documents Print #fnum, "Modules" & vbTab & doc.Name Next doc Set db = Nothing Close #fnumEnd Sub

Souhlasím  |  Nesouhlasím  |  Odpovědět

Související témata: 10, Vba ms, Cancel, Next, Exit, Stejné množství, Macro




Určitě si přečtěte

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

** Sonda LRO pořídila z oběžné dráhy Měsíce zajímavé snímky ** Jsou na nich vidět artefakty všech misí programu Apolla, které přistály na povrchu Měsíce ** Jde například o části lunárních modulů, rovery a dokonce i vlajky

Petr Kubala | 60

Šmírovačka kamerami Googlu: Koukněte se, co nového zachytily na Street View

Šmírovačka kamerami Googlu: Koukněte se, co nového zachytily na Street View

Google stále fotí celý svět do své služby Street View. A novodobou zábavou je hledat v mapách Googlu vtipné záběry. Podívejte se na výběr nejlepších!

redakce | 44

Nová zbraň Microsoftu proti iPadu: Levný tablet Surface Go bude stát jen deset tisíc

Nová zbraň Microsoftu proti iPadu: Levný tablet Surface Go bude stát jen deset tisíc

** Microsoft představil nový tablet Surface Go ** Nový model zaujme nízkou cenou, ale schopnostmi zařízení Surface ** Microsoft nepoužil čip ARM, ale klasický procesor od Intelu 

Karel Javůrek | 116

Apple: naše mapy budou nejlepší na světě. Tajně jsme na nich pracovali několik let

Apple: naše mapy budou nejlepší na světě. Tajně jsme na nich pracovali několik let

** Apple odhalil své plány na zcela nové mapy ** Několik let pracuje na nových mapách, které by měly předběhnout konkurenci ** Objeví se s příchodem iOS 12 pro vybrané státy

Karel Javůrek | 50


Aktuální číslo časopisu Computer

Velký test 18 bezdrátových sluchátek

Vše o přechodu na DVB-T2

Procesory AMD opět porážejí Intel

7 NVMe M.2 SSD v přímém souboji