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