Friendsnippets

1. Access DB PlainText Export

   view plain - save this

   .

     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 ' split funktion
    64 ' zerteil einen string und gibt einen array zurueck
    65 ' erst ab office 2000 in der standard library
    66 Function Split(ByVal strIn As String, _
    67     Optional ByVal strDelim As String = " ", _
    68     Optional ByVal lCount As Long = -1) _
    69         As Variant
    70 Dim vOut() As Variant
    71 Dim strSubString As String
    72 Dim k As Integer
    73 Dim lDelimPos As Long
    74 
    75 k = 0
    76 lDelimPos = InStr(strIn, strDelim)
    77 
    78 Do While (lDelimPos)
    79     ' Get everything to the left of the delimiter
    80     strSubString = Left(strIn, lDelimPos - 1)
    81     ' Make the return array one element larger
    82     ReDim Preserve vOut(k)
    83     ' Add the new element
    84     vOut(k) = strSubString
    85     k = k + 1
    86     If lCount <> -1 And k = lCount Then
    87     Split = vOut
    88     Exit Function
    89     End If
    90     ' Only interested in what's right of delimiter
    91     strIn = Right(strIn, (Len(strIn) - _
    92     (lDelimPos + Len(strDelim) - 1)))
    93     ' See if delimiter occurs again
    94     lDelimPos = InStr(strIn, strDelim)
    95 Loop
    96 
    97 ' No more delimiters in string.
    98 ' Add what's left as last element
    99 ReDim Preserve vOut(k)
   100 vOut(k) = strIn
   101 
   102 Split = vOut
   103 End Function
   104 
   105 'gibt den Pfad der Datenbank zurück
   106 Public Function GetDBPath() As String
   107     Dim strFullPath As String
   108     Dim i As Integer
   109 
   110     strFullPath = CurrentDb().Name
   111 
   112     For i = Len(strFullPath) To 1 Step -1
   113         If Mid(strFullPath, i, 1) = "\" Then
   114             GetDBPath = Left(strFullPath, i)
   115             Exit For
   116         End If
   117     Next
   118 End Function
   

   Posted by qrist0ph to visual basic .net access ... saved by 1 person ... 0 comments ... 1 month, 3 weeks

2. Aller Felder + Formel eines Berichts ausgeben

   view plain - save this

   .

    1 Sub felderVonBericht()
    2     Dim rpt As Report, ctl As Control
    3     Set rpt = Reports("Tagesberichtneu")
    4     ' Name des Berichts ausgeben.
    5     Debug.Print rpt.Name
    6     ' Controls-Auflistung jedes Berichts durchlaufen.
    7     For Each ctl In rpt.Controls
    8         If ctl.ControlType = acTextBox Then
    9             Debug.Print ctl.Name & ": " & ctl.Properties(3)
   10         End If
   11     Next ctl
   12 End Sub
   

   Posted by qrist0ph to c++ access metadata ... saved by 1 person ... 0 comments ... 1 month, 3 weeks

3. Loop durch alle Access Datenbank Container und Objekte

   view plain - save this

   .

    1 Sub foo()
    2 With CurrentDb
    3         ' Durchlaufen der Containers-Auflistung.
    4         For Each ctrLoop In .Containers
    5             Debug.Print "Eigenschaften von" & ctrLoop.Name & " Container"
    6             ' Durchlaufen der Properties-Auflistung jedes
    7             ' Container-Objekts.
    8             For Each prpLoop In ctrLoop.Properties
    9                 Debug.Print "    " & prpLoop.Name & " = "; prpLoop
   10             Next prpLoop
   11             
   12             For Each it In ctrLoop.Documents
   13                 Debug.Print it.Name
   14             Next
   15         Next ctrLoop
   16     End With
   17 End Sub
   

   Posted by qrist0ph to c++ access metadata ... saved by 1 person ... 0 comments ... 1 month, 3 weeks

Pages : 1