Posted By

qrist0ph on 05/13/08


Tagged

access


Versions (?)

Who likes this?

2 people have marked this snippet as a favorite

qrist0ph
eskey


Access Plain Text Export


 / Published in: Visual Basic
 

  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Public Function PlainTextExport()
  5. On Error GoTo Err_ExportDatabaseObjects
  6.  
  7. Dim db As Database
  8. 'Dim db As DAO.Database
  9. Dim td As TableDef
  10. Dim D As Document
  11. Dim c As Container
  12. Dim i As Integer
  13. Dim sExportLocation As String
  14.  
  15. Set db = CurrentDb()
  16.  
  17. sExportLocation = GetDBPath & "\exports\"
  18.  
  19. ' For Each td In db.TableDefs 'Tables
  20. ' If left(td.Name, 4) <> "MSys" Then
  21. ' DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".txt", True
  22. ' End If
  23. ' Next td
  24.  
  25. Set c = db.Containers("Forms")
  26. For Each D In c.Documents
  27. Application.SaveAsText acForm, D.Name, sExportLocation & "Form_" & D.Name & ".txt"
  28. Next D
  29.  
  30. Set c = db.Containers("Reports")
  31. For Each D In c.Documents
  32. Application.SaveAsText acReport, D.Name, sExportLocation & "Report_" & D.Name & ".txt"
  33. Next D
  34.  
  35. Set c = db.Containers("Scripts")
  36. For Each D In c.Documents
  37. Application.SaveAsText acMacro, D.Name, sExportLocation & "Macro_" & D.Name & ".txt"
  38. Next D
  39.  
  40. Set c = db.Containers("Modules")
  41. For Each D In c.Documents
  42. Application.SaveAsText acModule, D.Name, sExportLocation & "Module_" & D.Name & ".txt"
  43. Next D
  44.  
  45. For i = 0 To db.QueryDefs.Count - 1
  46. Application.SaveAsText acQuery, db.QueryDefs(i).Name, sExportLocation & "Query_" & db.QueryDefs(i).Name & ".txt"
  47. Next i
  48.  
  49. Set db = Nothing
  50. Set c = Nothing
  51.  
  52. MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
  53.  
  54. Exit_ExportDatabaseObjects:
  55. Exit Function
  56.  
  57. Err_ExportDatabaseObjects:
  58. MsgBox Err.Number & " - " & Err.Description
  59. Resume Exit_ExportDatabaseObjects
  60.  
  61. End Function
  62.  
  63.  
  64.  
  65. 'gibt den Pfad der Datenbank zurück
  66. Public Function GetDBPath() As String
  67. Dim strFullPath As String
  68. Dim i As Integer
  69.  
  70. strFullPath = CurrentDb().Name
  71.  
  72. For i = Len(strFullPath) To 1 Step -1
  73. If Mid(strFullPath, i, 1) = "\" Then
  74. GetDBPath = Left(strFullPath, i)
  75. Exit For
  76. End If
  77. Next
  78. End Function

Report this snippet  

You need to login to post a comment.