Category: All

Function TypicalDAOrecordset()

'Make sure the name of the recordset is unambiguous
'Good practice to reference the actual library
        
    Dim rs As DAO.Recordset
    Dim db As DAO.Database
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT * FROM T001Main where T001Main.ValueNumber = 0")
    
        'the data source can be a Table Name a query name or an sql string
        'it would be possible to change the SQL to set to another set of records
        'Check to see if there are any records in the set
        
        If Not (rs.EOF And rs.BOF) Then
        'there are no records if End of File and beginning of file are both true
        
            rs.MoveFirst
            
            Do Until rs.EOF = True
            rs.Edit
            rs!ValueNumber = 300
            rs.Update
            rs.MoveNext
            Loop
            Else
            MsgBox "No Records available for updating exit sub"
            Exit Function
            End If
            MsgBox "Looped through the records and updated ValueNumber field"
            
            rs.Close
            Set rs = Nothing
            Set db = Nothing
            
            'libraries for DAO can be found on AllenBrowne site
            'remember to break an infinite loop press ctrl + break

End Function

Not quite finished yet but place here for later correction.

Public Function CountAllTablesRows()
 
Dim rs As New ADODB.Recordset
Dim rsRC As New ADODB.Recordset
Dim strTbName As String
Dim lngRowCount As Long
Dim tbl As TableDef
CurrentProject.Connection.Execute "Delete from TABLE_INFO"
rs.Open "TABLE_INFO", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
For Each tbl In CurrentDb.TableDefs
  Select Case Left(tbl.Name, 4)
    Case "mSys"
    Case Else
      rs.AddNew
      rsRC.Open "Select count(*) as The_Count from [" & tbl.Name & "]", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
      rs.Fields("TBL_NAME") = tbl.Name
      rs.Fields("TBL_ROWCOUNT") = rsRC.Fields("The_Count")
      rs.Update
      rsRC.Close
      Set rsRC = Nothing
      'Debug.Print tbl.Name
  End Select
Next
rs.Close
Set rs = Nothing


MsgBox "Counted Numbers in Table"
 
End Function

Writing to Microsoft Word

Firstly a warning – this creates doc documents that can be opened in Word 2010 but are strictly speaking 03 iterations hence the doc suffix

First need to load in the library for Microsoft Word (this is 2003 version)

Then you are free to open and manipulate the items in Microsoft word..

Private Sub Command_Click()
On Error GoTo Err_Command_Click
 
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
   
    Set wrdApp = CreateObject("Word.Application")
    Set wrdDoc = wrdApp.Documents.Add ' create a new document
    wrdApp.Visible = True 
‘this line can be altered to not open the document on the screen
   
    With wrdDoc
       
        With .Styles(wdStyleHeading1).Font
            .Name = "Arial"
            .Size = 16
            .Bold = True
            .Color = wdColorBlack
        End With
        With .Styles(wdStyleHeading2).Font
            .Name = "Arial"
            .Size = 12
            .Bold = True
            .Color = wdColorBlack
        End With
        With .Styles(wdStyleNormal).Font
            .Name = "Arial"
            .Size = 10
            .Color = wdColorBlack
        End With
       
        .Content.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        .Content.ParagraphFormat.LineSpacing = 10
 
        .Range(0).Style = .Styles(wdStyleHeading1)
        .Content.InsertAfter "ThIS SHOULD BE HEADING1"
        .Content.InsertParagraphAfter
       
        .Range(.Characters.Count - 1).Style = .Styles(wdStyleHeading2)
        .Content.InsertAfter "THIS SHOULD BE HEADING2"
        .Content.InsertParagraphAfter
 
        .Range(.Characters.Count - 1).Style = .Styles(wdStyleNormal)
        .Content.InsertAfter "THIS SHOULD BE NORMAL"
        .Content.InsertParagraphAfter
               
        .SaveAs ("C:\CreatedWordDoc.doc")
        .Close ' close the document
    End With    ' With wrdDoc
   
    wrdApp.Quit ' close the Word application
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
 
Exit_Command_Click:
    Exit Sub
 
Err_Command_Click:
    MsgBox Err.Description
    Resume Exit_Command5_Click

An article on libraries specifically related to MS Access is available here
allenbrowne.com

Here’s some code I used to generate HTML for a web configuration file. It takes a database (the current open one) then looks to a query called QueryTargetInformation and places the fields – PlaceName / EastingMn / NorthingMn / EastingMx / NorthingMx in a HTML Structure and creates a file called CodeGeneratedHTML.txt place it on the C drive.

I put around 1,000 repeated links in HTML configuration file using this.

This was for a web mapping application – the eastings and northings were obtained from Ordnance Survey Open Source shape files from Ordnance Survey and then QGIS to get the eastings and northings of a variety of locations. These were transferred into the relevant columns of a database and this code triggered from the onclick event of a form command.

Private Sub Command_Click()
On Error GoTo Err_Command_Click
 
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("QueryTargetInformation")
Dim fs, TextFile
Set fs = CreateObject("Scripting.FileSystemObject")
Set TextFile = fs.CreateTextFile("c:\CodeGeneratedHTML.txt", True)
Do Until rst.EOF = True
TextFile.WriteLine ("<bookmark name=" & Chr$(34) & rst!PlaceName & Chr$(34) & ">")
TextFile.WriteLine ("   <min>")
TextFile.WriteLine ("       <x>" & rst!EastingMn & "</x>")
TextFile.WriteLine ("       <y>" & rst!NorthingMn & "</y>")
TextFile.WriteLine ("   </min>")
TextFile.WriteLine ("   <max>")
TextFile.WriteLine ("       <x>" & rst!EastingMx & "</x>")
TextFile.WriteLine ("       <y>" & rst!NorthingMx & "</y>")
TextFile.WriteLine ("   </max>")
TextFile.WriteLine ("</bookmark>")
rst.MoveNext
Loop
TextFile.Close
 
MsgBox "Created CodeGeneratedHTML File in C drive"
 
Exit_Command_Click:
    Exit Sub
 
Err_Command_Click:
    MsgBox Err.Description
    Resume Exit_Command_Click
 
End Sub

The following uses a function and the before update event of a form.

Sometimes it can be useful to have some kind of order field in the child records to indicate the order or version numbers of items. Although an incrementing Primary Key can be used child records may be in the thousands and if related to the parent you may want a simple almost ranking within the group. Which may be more meaningful when viewed filtered according to the parent.

A particular case may be where you are storing documents which have some kind of version.

 Public Function GetChildCount(OrderNo as Integer) As Integer

Dim intCount as Integer
intCount = DCount("FKID","[ParentTable]","[FKID]=" & OrderNo)
GetChildCount = IntCount + 1

End Function

This counts the number of records with the same FKID in the table called ParentTable with a FKID equal to OrderNo

Then within the before update event of the Sub_Form

Private Sub Form_BeforeUpdate(Cancel As Integer)

If Me.NewRecord Then
Me.Order = GetChildCount([SiteID])
End If

End Sub

The If statement just ensures that when you edit a record the order is not updated to the count of the child records if a count already exists in the field Order.

Boolean Switch to test for specific character sets within a field. This codes tests whether a field contains blanks or the specified characters only and will return -1 if true and 0 if false. If a character occurs that is not within the LValid_Values it will return 0 as false. This is different from identifying whether a field contains the listed characters. This can be useful for identifying characters in a field that you are wanting to alter the variable type. MS Access (and other databases) will delete field values that cannot be converted so if possible you want to identify values with illegal characters. This code can be used to identify this. Change the value of LValid_Values to represent the allowable characters and then you can reference the function in a query to identify illegal records and values. My primary use case is testing for numerical values in a string field which I am looking to alter so that I can change it into a long integer variable type. This is particularly useful for hunting down things like letters in house numbers or slashes in flat identities.

Function CharCheck(targetField) As Boolean

   Dim LPos As Integer
   Dim LChar As String
   Dim LValid_Values As String
   
   'Start at first character in strField
   LPos = 1
   
   LValid_Values = ".0123456789"
    'Test each character in strField
   While LPos <= Len(targetField)
      'Single character in strField
      LChar = Mid(targetField, LPos, 1)
    
      'If character is not LValid Value, return FALSE
      If InStr(LValid_Values, LChar) = 0 Then
         CharCheck = False
         Exit Function
      End If
    
         'Increment counter
       LPos = LPos + 1
       
   Wend
  

   'Value is LValid Value, return TRUE
   CharCheck = True
 
End Function