All pastes #345297 Raw Edit

Miles

public text v1 · immutable
·published 2007-02-08 11:41 UTC
rendered paste body
Sub RandomiseFields(TableName As String, Fields As String)
    Dim cnn As Connection, rs As Recordset, CurrentField As Variant, i As Integer
    Set cnn = CurrentProject.AccessConnection
    Set rs = New Recordset

    rs.Open "SELECT " & Fields & " FROM " & TableName, cnn, adOpenStatic, adLockPessimistic
    
    While Not rs.EOF
        i = 0
        For Each CurrentField In rs.Fields
            If Defined(CurrentField) Then: rs.Fields(i) = RandomString(CurrentField)
            i = i + 1
        Next CurrentField
        rs.MoveNext
    Wend
            
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    
End Sub

Function RandomString(SourceString As Variant) As String
    Dim x As Integer, y As Integer, ReturnString() As String
    
    y = Len(SourceString)
    ReDim ReturnString(1 To y) As String
    
    For x = 1 To y
        ReturnString(x) = RandomLetter(Mid(SourceString, x, 1))
    Next x
        
    RandomString = Join(ReturnString, "")
    
End Function

Function RandomLetter(SourceLetter As String) As String
    If SourceLetter = " " Then: RandomLetter = SourceLetter: Exit Function
    Dim Asc As Long
    
    Randomize
    Asc = vbKeyA + CLng(Rnd * (vbKeyZ - vbKeyA))
    Randomize
    
    If Rnd > 0.5 Then
        RandomLetter = LCase$(Chr$(Asc))
    Else
        RandomLetter = UCase$(Chr$(Asc))
    End If
    
End Function

Function Defined(Optional Variable As Variant) As Boolean
    On Error GoTo Fail
    If Not Len(Variable) = 0 Then: Defined = True: Exit Function
Fail:
    Defined = False
End Function