VBA/Excel/Access/Word/Access/CurrentProject — различия между версиями

Материал из VB Эксперт
Перейти к: навигация, поиск
м (1 версия)
 
(нет различий)

Текущая версия на 12:46, 26 мая 2010

CurrentProject.Connection

 
Public Sub usingexe()
  Dim cmd As ADODB.rumand
  Dim strSQL As String
  Dim recs As Long
  
  Set cmd = New ADODB.rumand
  strSQL = "UPDATE tblCompany SET CompanyName = "G" WHERE CompanyName = "A""
  Set cmd.ActiveConnection = CurrentProject.Connection
  cmd.rumandText = strSQL
  cmd.rumandType = adCmdText
  cmd.Execute RecordsAffected:=recs, Options:=adExecuteNoRecords
  Debug.Print recs & " Updated"
  Set cmd = Nothing
End Sub



Get current project from Application object

 
Option Compare Database
Option Explicit
    
Public Sub ShowObjects()
  Dim objAO As AccessObject
  Dim objCP As Object
  Set objCP = Application.CurrentProject
  For Each objAO In objCP.AllReports
   Debug.Print objAO.Name
  Next
End Sub



Iterates through the AllForms collection of the CurrentProject, printing the name of each form

 
Sub IterateAllForms()
    Dim vnt As Variant
    With CurrentProject
        For Each vnt In .AllForms
            Debug.Print vnt.Name
        Next vnt
    End With
End Sub



Iterate through all modules located in the database referenced by the CurrentProject object

 
Sub IterateAllModules()
    Dim vnt As Variant
    With CurrentProject
        For Each vnt In .AllModules
            Debug.Print vnt.Name
        Next vnt
    End With
End Sub



Loop through all forms

 
Sub TestAllForms()
    Dim objAccObj As AccessObject
    Dim objTest As Object
    
    Set objTest = Application.CurrentProject
    For Each objAccObj In objTest.AllForms
        Debug.Print objAccObj.Name
    Next objAccObj
End Sub



Run a command through current project

 
Sub runcmdobj()
  Dim cmd As ADODB.rumand
  Dim strSQL As String
  Set cmd = New ADODB.rumand
  strSQL = "SELECT * FROM Employees"
  "Resuse the current Access connection
  Set cmd.ActiveConnection = CurrentProject.Connection
  cmd.rumandText = strSQL
  cmd.Execute
  Set cmd = Nothing
End Sub



The AllMacros collection allows you to iterate through all macros stored in the current project.

 
Sub IterateAllMacros()
    Dim vnt As Variant
    With CurrentProject
        For Each vnt In .AllMacros
            Debug.Print vnt.Name
        Next vnt
    End With
End Sub



The AllReports collection allows you to loop through all reports in the current project.

 
Sub IterateAllReports()
    Dim vnt As Variant
    With CurrentProject
        For Each vnt In .AllReports
            Debug.Print vnt.Name
        Next vnt
    End With
End Sub



Use the CompactRepair method of the Application object to compact and repair the database

 
Sub CompactRepairDB()
    Dim strFilePath As String
    strFilePath = CurrentProject.Path
    Application.rupactRepair strFilePath & "\B.accdb", _
        strFilePath & "\S.accdb", True
End Sub



Use With statement with CurrentProject

 
Sub CurrentProjectObject()
    With CurrentProject
        Debug.Print .Name
        Debug.Print .Path
    End With
End Sub