M_Logger

最新推荐文章于 2024-12-26 09:45:39 发布

原创最新推荐文章于 2024-12-26 09:45:39 发布 · 260 阅读

CC 4.0 BY-SA版权

Option Explicit

’ Log文件的文件夹?
Public Const Log_Dir = “\Log”

’ Log类型
Public Const Log_Debug = ” 调试 ”
Public Const Log_Prompt = ” 提示 ”
Public Const Log_Warning = ” 警告 ”
Public Const Log_Error = ” 错误 “

’ LOGMessage 错误
Public Const E_MESSAGE = “系统错误，请询问管理员！”
Public Const E_MESSAGE1 = “Config文件中没有取到任何信息！”
Public Const E_MESSAGE2 = “行没有文件名！”
Public Const E_MESSAGE3 = “行没有种别！”
Public Const E_MESSAGE4 = “行没有频率！”
Public Const E_MESSAGE5 = “错误种别，请更正！”
Public Const E_MESSAGE6 = “文件中不存在Sheet ”
Public Const E_MESSAGE7 = “取得的箱号为空，请询问管理员！ ”
Public Const E_MESSAGE8 = “文件中已经存在！ ”
Public Const E_MESSAGE9 = “日期输入有误！”

’ LOGMessage 提示
Public Const I_MESSAGE1 = ” 发信成功！”
Public Const I_MESSAGE2 = ” 文件已作成！”
Public Const I_MESSAGE3 = ” ———-自动发信开始———-”
Public Const I_MESSAGE4 = ” ———-自动发信结束———-”
Public Const I_MESSAGE5 = ” 暂收警告开始！”
Public Const I_MESSAGE6 = ” 暂收警告结束！”
Public Const I_MESSAGE7 = ” 验收警告开始！”
Public Const I_MESSAGE8 = ” 验收警告结束！”

’ LOGMessage 警告
Public Const W_MESSAGE1 = ” 文件没有生成！”

‘**************************************************************************************
‘* 功能：写Log
‘* 参数： strType：；strSheetName：；strValue：
‘* 返回值：
‘* 备注：
‘**************************************************************************************
Public Sub WriteLog(ByVal strType As String, ByVal strSheetName As String, ByVal strValue As String)
Dim strFileName As String
Dim strLogPath As String
Dim strOutPut As String
Dim intFF As Integer
Dim strLog As String

On Error GoTo WriteLog_Err

strLog = ".log"

' 输出内容
strOutPut = Format(Now(), "YYYY/MM/DD HH:MM:SS") & strType & GetSheetName(strSheetName) & strValue

' 输出头部
strFileName = "自动发信_" & Format(Now(), "YYYYMMDD") & strLog

' 文件路径
strLogPath = GetPath(strFileName)

If Len(strLogPath) > 0 Then

    intFF = FreeFile

    Open strLogPath For Append As #intFF

    Print #intFF, strOutPut

    Close #intFF

End If

Exit Sub

WriteLog_Err:
MsgBox Err.Number & ” ” & Err.Description

End Sub

‘**************************************************************************************
‘* 功能：取得当前路径
‘* 参数：
‘* 返回值：
‘* 备注：
‘**************************************************************************************
Private Function GetPath(ByVal strFileName As String) As String

Dim strMyFolder As String

On Error GoTo GetPath_Err

strMyFolder = g_Path & Log_Dir

If Dir(strMyFolder, vbDirectory) = "" Then
    MkDir (strMyFolder)
End If

GetPath = strMyFolder & "\" & strFileName

Exit Function

GetPath_Err:
GetPath = “”
MsgBox Err.Number & ” ” & Err.Description

End Function

‘**************************************************************************************
‘* 功能：文件名不满30位补空格
‘* 参数：
‘* 返回值：
‘* 备注：
‘**************************************************************************************
Private Function GetSheetName(ByVal strFileName As String) As String

Dim strTmpFileName As String
strTmpFileName = strFileName

Do While Len(strTmpFileName) < 30
    strTmpFileName = strTmpFileName + SPACE
Loop
GetSheetName = UCase(strTmpFileName)

End Function