Aktuelle VBA -Notizen

Tips zum Schluß

Wenn man alle seine Makros in einem einzigen Modul sammelt, hat dies den Vorteil, daß man sie leicht als eine Textdatei sichern und übertragen kann.
Wenn in einer Schleife der Operator »&« verwendet wird, um Zeichenfolgen an eine Zeichenfolgenvariable anzuhängen, kann dies sehr langsam sein. Hier ist es besser, eine große Zeichenfolge mit Leerzeichen zu füllen und dann an Stelle des Anhängens eine Zuweisung an Mid zu verwenden, ohne die Länge der Zeichenfolge dabei zu verändern.

Gleiche Zahl in mehreren Dateien finden

Es sollen alle Zahlen gefunden werden, die in mehr als einer Datei vorkommen.

Eingetragen sind alle Zahlen aus jeder Datei, wobei eine Zahl auch mehrfach in einer Datei vorkommen kann.

Die innere Abfrage »SELECT DISTINCT Zahl, Datei FROM Tabelle1« eliminiert alle Wiederholungen einer Zahl in derselben Datei.

Die äußere Abfrage wählt dann danach alle übriggebliebenen Zahlen aus, die mehr als einmal vorkommen.

SQL

SELECT Zahl AS F FROM( SELECT DISTINCT Zahl, Datei FROM Tabelle1 )GROUP BY Zahl HAVING Count( Zahl )> 1;

Der SQL-Kurs beginnt am Montag (2. November 2015, Montag und Dienstag, 18.40 – 21.40 Uhr; 8×, 32 UE, keine Pause, Raum 508, Tegel-Center, Buddestr. 21, 13 507 Berlin).

Quelltext vom 2015-10-13

Modul1

Sub Main()
  Dim haupt As Workbook
  Dim first As Boolean
  Dim v As String
  Dim row As Integer
  Dim ww As Integer
  Dim Path As String
  Dim Db As Database
  Dim Rs As Recordset
  Path = "C:\Users\vhs\Documents\Projekt\db.accdb"
  'Path = "C:\Users\abc\Documents\Projekt\db.mdb"
  ' Verweis: "Microsoft Office 15 Access Database Engine Object Library"
  ' (Beim Dateiformat .mdb wäre auch "Microsoft DAO 3.6 Object Library" möglich)
  Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
  '
  ' Löschen von Tabelle1
  On Error Resume Next
  Db.TableDefs.Delete "Tabelle1"
  On Error GoTo 0
  '
  ' Anlegen von Tabelle1
  Dim tdf As DAO.TableDef
  Dim fld As DAO.Field
  Set tdf = Db.CreateTableDef("Tabelle1")
  Set fld = tdf.CreateField("ID", dbLong)
  fld.Attributes = dbAutoIncrField + dbFixedField
  tdf.Fields.Append fld
  Set fld = tdf.CreateField("Zahl", dbText, 30)
  tdf.Fields.Append fld
  Set fld = tdf.CreateField("Datei", dbText, 30)
  tdf.Fields.Append fld
  Db.TableDefs.Append tdf
  Set fld = Nothing
  Set tdf = Nothing
 '
  Set Rs = Db.OpenRecordset("Tabelle1")
  ChDrive ("C:")
  ChDir ("C:\Users\vhs\Documents\Projekt")
  Let first = True
  Application.ScreenUpdating = False
  Do
    If first Then v = Dir("") Else v = Dir()
    Let first = False
    If v <> "" Then
      Dim w As Integer
      Let w = Val(v)
        If w > 0 Then
          Workbooks.Open Filename:=v
          Let row = 1
          Set R = Cells(row, 1)
          Let ww = R.Value
          Do While ww <> 0
            With Rs
              .AddNew
              .Fields("Zahl").Value = R.Value
              .Fields("Datei").Value = v
              .Update
            End With
            Let row = row + 1
            Set R = Cells(row, 1)
            Let ww = R.Value
          Loop
          ActiveWorkbook.Close
        End If
    End If
  Loop While v <> ""
  Application.ScreenUpdating = True
  Rs.Close
  Set Rs = Nothing
  Set Rs = Db.OpenRecordset _
  (              "SELECT Zahl AS F FROM"                             & _
                 "( SELECT DISTINCT Zahl, Datei FROM Tabelle1 )"     & _
                 "GROUP BY Zahl HAVING Count( Zahl )> 1;"            )
  Do While Not Rs.EOF
    Debug.Print Rs!F
    Rs.MoveNext
  Loop
  Rs.Close
  Set Rs = Nothing
  Db.Close
  Set Db = Nothing
End Sub

Quelltext vom 2015-10-12

Modul1

Sub Schaltfläche2_Klicken()
  Dim first As Boolean
  Dim v As String
  Dim max As Integer
  max = 1
  ChDir ("C:\Users\abc\Documents\Projekt")
  Let first = True
  Do
    If first Then v = Dir("") Else v = Dir()
    Let first = False
    If v <> "" Then
      Dim w As Integer
      Let w = Val(v)
      If w > max Then Let max = w
    End If
  Loop While v <> ""
  Dim nextNumber As Integer
  nextNumber = max + 1
  FileCopy "1.xlsm", nextNumber & ".xlsm"
End Sub
Sub Schaltfläche3_Klicken()
  Dim haupt As Workbook
  Dim first As Boolean
  Dim v As String
  Dim row As Integer
  ChDir ("C:\Users\abc\Documents\Projekt")
  Let first = True
  Let row = 1
  Application.ScreenUpdating = False
  Do
    If first Then v = Dir("") Else v = Dir()
    Let first = False
    If v <> "" Then
      Dim w As Integer
      Let w = Val(v)
        If w > 0 Then
          Set haupt = ActiveWorkbook
          Workbooks.Open Filename:=v
          Set R = Range("a1")
          Set T = haupt.Sheets("Tabelle1")
          Let T.Cells(row, 1) = R
          Let row = row + 1 ' Let row = w
          ActiveWorkbook.Close
        End If
    End If
  Loop While v <> ""
  Application.ScreenUpdating = True
End Sub
Sub Main()
  Dim haupt As Workbook
  Dim first As Boolean
  Dim v As String
  Dim row As Integer
  Dim ww As Integer
  Dim Path As String
  Dim Db As Database
  Dim Rs As Recordset
  Path = "C:\Users\abc\Documents\Projekt\db.accdb"
  ' Verweis: Microsoft Office 15 Access Database Engine Object Library
  ' (Beim Dateiformat .mdb wäre auch DAO 3.6 möglich)
  Set Db = Workspaces(0).OpenDatabase(Path, ReadOnly:=True)
  Set Rs = Db.OpenRecordset("Tabelle1")
  ChDir ("C:\Users\abc\Documents\Projekt")
  Let first = True
  Application.ScreenUpdating = False
  Do
    If first Then v = Dir("") Else v = Dir()
    Let first = False
    If v <> "" Then
      Dim w As Integer
      Let w = Val(v)
        If w > 0 Then
          Workbooks.Open Filename:=v
          Let row = 1
          Set R = Cells(row, 1)
          Let ww = R.Value
          Do While ww <> 0
            With Rs
              .AddNew
              .Fields("Zahl").Value = R.Value
              .Fields("Datei").Value = v
              .Update
            End With
            Let row = row + 1
            Set R = Cells(row, 1)
            Let ww = R.Value
          Loop
          ActiveWorkbook.Close
        End If
    End If
  Loop While v <> ""
  Application.ScreenUpdating = True
End Sub

Aktuellen Benutzer ermitteln (2015-09-29)

»`Access.Application.CurrentUser`«

Dieser Benutzer ist wohl nur bei Verwendung der aufgegebenen “user-level security ” (ULS) mit einer “security-enabled workgroup ” sinnvoll.

Notiz

? Access.Application.CurrentUser

Admin

Notiz

http://msdn.microsoft.com/en-us/library/office/ff845778.aspx

Application.CurrentUser Method (Access)

Office 2013

CurrentUser Name of the current user of the database

CurrentWebUser Current user of a Web database on Microsoft SharePoint Foundation 2010

Aktueller Windows -Benutzer

Durch Aufruf von »GetUserName« kann der unter Windows angemeldete Benutzer abgefragt werden.

Notiz

Public Declare Function GetUserName Lib "advapi32.dll" 
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Dim strLen As Long,strtmp As String * 256,strUserName As String
strLen = 255: GetUserName strtmp, strLen : strUserName = Trim$(TrimNull(strtmp))

Durch Aufruf von »Environ("USERNAME")« kann der unter Windows angemeldete Benutzer abgefragt werden. Dieser Abfrage ist allerdings weniger sicher, da diese Einstellung leicht gefälscht werden kann.

Notiz

Function UserNameWindows() As String
     UserName = Environ("USERNAME")
End Function

“Access 2013 ”-Zugangsabsicherung

Die Absicherung des Zugangs zu einer Datenbank mit Access 2013 ist ein umfangreiches Thema, das den Rahmen des VBA -Kurses sprengen würde. Es gehört auch eher in einen Access 2013 -Kurs, da es nicht speziell mit VBA zu tun hat.

Selbstprogrammierte Sicherung

Eine selbstprogrammierte Zugriffssicherung auf Formular-Ebene ist immer möglich, allerdings kann sie leicht umgangen werden. Sie kann aber mit VBA realisiert werden.

Aktuelle VBA -Notizen

Tips zum Schluß

Gleiche Zahl in mehreren Dateien finden

Quelltext vom 2015-10-13

Quelltext vom 2015-10-12

Aktuellen Benutzer ermitteln (2015-09-29)

»Access.Application.CurrentUser«

Aktueller Windows -Benutzer

“Access 2013 ”-Zugangsabsicherung

Selbstprogrammierte Sicherung

»`Access.Application.CurrentUser`«