more-vba.md

Public Function rotateImage(filepath As String, Optional angleToRotate As Integer = 90) As Boolean

On Error GoTo handleError

    Dim WIA As Object
    Dim imageProcess As Object
    Dim FSO As FileSystemObject
    Dim originalFileName As String
    Dim newFileName As String
    
    Set WIA = CreateObject("WIA.ImageFile")
    Set imageProcess = CreateObject("WIA.ImageProcess")
    Set FSO = New FileSystemObject
    
    imageProcess.Filters.Add imageProcess.FilterInfos("RotateFlip").FilterID
    imageProcess.Filters(1).Properties("RotationAngle") = angleToRotate
    
    WIA.LoadFile filepath
    Set WIA = imageProcess.Apply(WIA)
    originalFileName = getFileParentPath(filepath) & getFileName(filepath)
    newFileName = getFileParentPath(filepath) & getFileName(filepath) & "-1" & getFileExtension(filepath)
    WIA.SaveFile newFileName
    
    ''
    '' Delete original file
    ''
    FSO.DeleteFile originalFileName, True
    FSO.CopyFile newFileName, originalFileName, True
    FSO.DeleteFile newFileName
    
    rotateImage = True
    GoTo cleanUp

cleanUp:
    Set imageProcess = Nothing
    Set WIA = Nothing
    Set FSO = Nothing
    Exit Function
    
handleError:
    rotateImage = False
    Call logError(Err.Number, Err.description, "rotateImage()", "Error rotating an image, Image Path: " & filepath)
    Exit Function

End Function

'---------------------------------------------------------------------------------------
' Procedure : testAssertion
' Author    : Wyatt Castaneda
' Date      : 2/18/2009
' Purpose   : Takes a user defined function, test data, and a correct answer to
'           : run a test of the function
' Params    : functionToTest as string
'           : testData as variant
'           : correctAnswer as variant
' Returns   : None
' Test      : None
'---------------------------------------------------------------------------------------

Public Function testAssertion(functionToTest, correctAnswer As Variant, Optional testData As Variant = vbNull)
    
    Dim toAssert As Variant
    
    ''
    '' Store the computed value
    ''
    If testData = vbNull Then
        toAssert = Application.Run(functionToTest)
    Else
        toAssert = Application.Run(functionToTest, testData)
    End If
    
        
    ''
    '' Compare the computed value vs correct value
    ''
    If toAssert = correctAnswer Then
        Debug.Print "Test: " & functionToTest; ", Result: Passed"
    Else
        Debug.Print "Test: " & functionToTest; ", Result: Failed"
    End If
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : runUnitTests
' Author    : Wyatt Castaneda
' Date      : 09/07/2018
' Purpose   : Run the user defined unit tests, some test files will need to edited to pass
'           : when switching computers/users, for example getComputerName
' Params    : None
' Returns   : None
' Test      : None
'---------------------------------------------------------------------------------------

Public Function runUnitTests()
    Call test_getUsername
    Call test_getPathToUserDesktop
End Function

Public Function logActivity(activityName As String, activityDesc As String, Optional category As String = "general") As Boolean
    Dim insertQry As String
    Dim username As String
    On Error GoTo handleError
        username = getUsername()
        insertQry = "INSERT INTO tblActivityLog (activity, event, username, category)"
        insertQry = insertQry & " VALUES ('" & escapeSQL(activityName) & "', '" & escapeSQL(activityDesc) & "', '" & username & "', '" & category & "')"
        CurrentDb.Execute insertQry
        logActivity = True
        Exit Function
         
handleError:
    Call logError(Err.Number, Err.description, "logActivity()", "Error logging activity")
    logActivity = False
    Exit Function
End Function

Public Function logError(errorNo As Variant, errorDesc As String, eventName As String, eventDesc As String) As Boolean
    On Error GoTo handleError
        Dim errorNoStr, errorDescStr, eventNameStr, eventDescStr, computerName As String
        Dim fileName, appVersion, appBuild, username, OSInfo As String
        errorNoStr = escapeSQL(CStr(errorNo))
        errorDescStr = escapeSQL(errorDesc)
        eventNameStr = escapeSQL(eventName)
        eventDescStr = escapeSQL(eventDesc)
        computerName = getComputerName()
        fileName = Application.CurrentProject.name
        appVersion = CStr(Application.Version)
        appBuild = CStr(Application.build)
        username = getUsername
        OSInfo = GetOSName()
        Dim insertQry As String
        insertQry = "INSERT INTO tblLogErrors " _
                    & "(errorNo, errorDesc, eventName, eventDesc, username, computerName, fileName, applicationVersion, applicationBuild, OSInfo) VALUES " _
                    & "('" & errorNoStr & "', '" & errorDescStr & "', '" & eventNameStr & "', '" & eventDescStr & "', '" & username & "', '" & computerName & "', '" & fileName & "', " _
                    & "'" & appVersion & "', '" & appBuild & "', '" & OSInfo & "')"
        CurrentDb.Execute insertQry, dbFailOnError
        logError = True
        Exit Function
    
handleError:
    logError = False
    Exit Function
End Function

Function getRandNo(lowerLimit, upperLimit) As Long

On Error GoTo Error_Handler
        
    lowerLimit = lowerLimit + 1
    upperLimit = upperLimit - 1

    'Calculate our random number!
    Randomize
    getRandNo = Int((upperLimit - lowerLimit + 1) * Rnd + lowerLimit)
    Exit Function

Error_Handler:
    On Error Resume Next
    Exit Function
    
End Function

Public Sub getGenericErrorMessage(Optional customMessage As String = "", Optional displayEmailAdmin As Boolean = False)
    
    Call setGlobalVars
    
    Dim message As String
    
    If displayEmailAdmin = False Then
        If customMessage <> "" Then
            message = customMessage
        Else
            message = "Error...the application could not complete the last action try again later."
        End If
        MsgBox message, vbOKOnly + vbCritical, appName & " | Error"
    Else
        If customMessage <> "" Then
            message = customMessage & " Please contact the database admin at: [email protected]"
        Else
            message = "Error...the application could not complete the last action. Please contact the database admin at: [email protected]."
        End If
        MsgBox message, vbOKOnly + vbCritical, appName & " | Error"
    End If
    
End Sub