Log

原创
2018/08/08 07:18
阅读数 2

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

展开阅读全文
打赏
0
0 收藏
分享

作者的其它热门文章

加载中
更多评论
打赏
0 评论
0 收藏
0
分享
返回顶部
顶部