• Home
 · 
• Miscellaneous
 · 
• Function to Create Automatic Log file and create new log file if it reaches 5 MB size - Passing Mes

Function to Create Automatic Log file and create new log file if it reaches 5 MB size - Passing Mes

Function to Create Automatic Log file and create new log file if it reaches 5 MB size - Passing Message as parameter

Rate Function to Create Automatic Log file and create new log file if it reaches 5 MB size - Passing Mes

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    'This function writes the error message to the log file
    On Error GoTo LOCALERRORHABNDLER
    Dim objToFSO     As New FileSystemObject
    Dim objFile      As File                    'A file of the folder
    Dim strLogFolder As String
    Dim strFileName  As String
    Dim strBkupFile  As String                  'Backup file name
    Const FILESIZE   As Double = 5120000        '5 MB
    
LOGPROCESS:
    'To construct the Error Message
    strMessage = Format(Now, "YYYYMMDDHHMMSS") & " : " & Trim(strMessage) & vbCrLf
    If Trim(LOGFOLDER) = "" Then
        strLogFolder = App.Path & "\Log"
    Else
        If InStr(1, LOGFOLDER, ":\") > 0 Then
            strLogFolder = LOGFOLDER
        Else
            strLogFolder = App.Path & "\" & LOGFOLDER
        End If
    End If
    
    If fnCHKFILE(strLogFolder, True) = False Then
        objToFSO.CreateFolder strLogFolder
    End If
    
    strFileName = strLogFolder & "\log.txt"

    If objToFSO.FileExists(strFileName) Then
        Set objFile = objToFSO.GetFile(strFileName)
        'File size excceds the limit, then take a backup
        If objFile.Size > FILESIZE Then
            strBkupFile = Left(strFileName, Len(strFileName) - 4)
            strBkupFile = strBkupFile & "_" & Format(Now, "YYYYMMDDHHMM") & ".txt"
            objFile.Copy strBkupFile, True
            objFile.Delete True
            objToFSO.CreateTextFile (strFileName)
        End If
    Else
        'if the file does not exists then it is created
        objToFSO.CreateTextFile (strFileName)
        Set objFile = objToFSO.GetFile(strFileName)
    End If

    Set objToFSO = Nothing
    Set objFile = Nothing
    
    Call fnMAKEFILE(strFileName, strMessage, True)
    
    fnERRLOG = True
    Exit Function

LOCALERRORHABNDLER:
    If Err.Number = 76 Or Err.Number = 52 Then
        LOGFOLDER = ""
        GoTo LOGPROCESS
    End If
    Set objFile = Nothing
    fnERRLOG = False
End Function

'=============================================

Public Function fnMAKEFILE(strFileName As String, strTOWRITE As String, Optional blnAPPMODE As Boolean) As Boolean
    '---------------------------------------------------------
    'This function will Create XML file
    '---------------------------------------------------------
    On Error GoTo LOCALERRORHANDLER
    Dim intFNum  As Double                    'File number of opened file
    
    intFNum = FreeFile
        
    'Create or Append a file
    '---------------------------------------------------------
    If blnAPPMODE Then
        Open strFileName For Append As #intFNum
    Else
    '---------------------------------------------------------
        Open strFileName For Output As #intFNum
    End If
    '---------------------------------------------------------
    Print #intFNum, strTOWRITE;
    Close #intFNum
    '---------------------------------------------------------
    fnMAKEFILE = True
    
    Exit Function
LOCALERRORHANDLER:
    Close #intFNum
End Function