Maon

原创
2018/08/08 07:20
阅读数 16

Option Explicit

Option Base 1

'config数据二维数组

Public ConfigData() As String

Private End_Row As Integer

'************************************************************************************************

'* 功能 入口

'* 参数

'* 返回值:

'* 备注

'************************************************************************************************

'Public Sub auto_open()

Sub Main_Click()

'如果有错误直接goto

On Error GoTo ErrHandler

' 初始化全局变量

Call InitializeVariant

' 自动发信开始

Call WriteLog(Log_Prompt, "Main", I_MESSAGE3 & " " & Now())

' 生成事务连接 并且 取得设定文件内容

If DB_Connect = False Or GetConfigData = False Then

Exit Sub

End If

' 按照Config文件的设定生成指定文件

Call CreateFile

' 发信

'Call SendMail

' 关闭事务连接

Call DB_Close

' 自动发信结束

Call WriteLog(Log_Prompt, "Main", I_MESSAGE4 & " " & Now())

Call DB_Close

' 关闭Excel

'Call Closes

Exit Sub

ErrHandler:

Call DB_Close

Call WriteLog(Log_Error, "AUTO_OPEN", Err.Description)

Call Closes

End Sub

Private Sub Closes()

Application.DisplayAlerts = False

Application.Quit

End Sub

'************************************************************************************************

'* 功能 初始化全局变量

'* 参数

'* 返回值:

'* 备注

'************************************************************************************************

Public Sub InitializeVariant()

' 取得当前时间的日期 YYYYMMDD

Call Get_Date

' 取得当前时间的日期 DD

Call Get_Day

' 取得当前时间的WeekDay 1,2,3,4,5,6,7

Call Get_WeekDay

' 取得本文件路径

Call Get_Path

' 取得本机用户名

Call Get_LocalHostName

End Sub

'************************************************************************************************

'* 功能 取得设定文件内容到二维数组中

'* 参数

'* 返回值:

'* 备注

'************************************************************************************************

Private Function GetConfigData() As Boolean

Dim intRow As Integer

Dim intCol As Integer

Dim intRowCount As Integer

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim configSheet As Excel.Worksheet

On Error GoTo ErrHandler

GetConfigData = False

'创建EXCEL对对象

Set xlApp = CreateObject("Excel.Application")

'打开已经存在的EXCEL工件簿文件

Set xlBook = xlApp.Workbooks.Open(g_Path & "\" & Config_FileName & File_ExtentionName)

'设置EXCEL对象可见与否

xlApp.Visible = False

'设置活动工作页

Set configSheet = xlBook.Sheets(1)

intRow = Start_Row

intRowCount = 0

' 取得文件个数

Do While True

If IsNull(configSheet.Cells(intRow, 2)) Or configSheet.Cells(intRow, 2) = "" Then

Exit Do

End If

intRow = intRow + 1

intRowCount = intRowCount + 1

Loop

' 如果取得的文件个数为0,退出

If intRowCount = 0 Then

xlBook.Close

' 结束EXCEL对象

xlApp.Quit

' 释放xlApp对象

Set xlApp = Nothing

GetConfigData = False

Call WriteLog(Log_Error, "GETCONFIGDATA", E_MESSAGE1)

Exit Function

End If

' 根据总行数求出结束行

End_Row = Start_Row + intRowCount - 1

' 定义二维数组,最后一列记录该文件是否今天作成

ReDim ConfigData(intRowCount, END_COL - Start_Col + 2)

' 将文件信息写入数组

For intRow = Start_Row To End_Row

For intCol = Start_Col To END_COL

If configSheet.Cells(intRow, intCol).MergeCells = True Then

ConfigData(intRow - Start_Row + 1, intCol - Start_Col + 1) = configSheet.Cells(configSheet.Cells(intRow, intCol).MergeArea.Row, intCol)

Else

ConfigData(intRow - Start_Row + 1, intCol - Start_Col + 1) = Trim(configSheet.Cells(intRow, intCol))

End If

Next intCol

Next intRow

xlBook.Close

' 结束EXCEL对象

xlApp.Quit

' 释放xlApp对象

Set xlApp = Nothing

GetConfigData = True

Exit Function

ErrHandler:

xlBook.Close

' 结束EXCEL对象

xlApp.Quit

' 释放xlApp对象

Set xlApp = Nothing

GetConfigData = False

Call WriteLog(Log_Error, "GETCONFIGDATA", Err.Description)

End Function

'************************************************************************************************

'* 功能 按照Config文件的设定生成指定文件

'* 参数

'* 返回值:

'* 备注

'************************************************************************************************

Private Sub CreateFile()

Dim i As Integer

On Error GoTo ErrHandler

For i = 1 To UBound(ConfigData, 1)

' 检查该文件是否应该今天生成,如果生成的话,

' 就在二维数组该行末尾记录1,否则为0。发信用

If IsCreateFile(i) = True Then

Select Case ConfigData(i, C_FILENAME)

Case case1

' 暂收警告

Call zanshou.Create(i)

' 验收警告

Call yanshou.Create(i)

Case Else

Call DB_Close

Call WriteLog(Log_Warning, "CREATEFILE", "" & i & E_MESSAGE2)

Exit Sub

End Select

End If

Next i

Exit Sub

ErrHandler:

Call WriteLog(Log_Error, "CREATEFILE", Err.Description)

End Sub

'************************************************************************************************

'* 功能 检查该文件是否应该今天生成

'* 参数

'* 返回值:

'* 备注

'************************************************************************************************

Private Function IsCreateFile(ByVal i As Integer) As Boolean

Dim strType As String

Dim strRate As String

Dim strRateArray() As String

Dim j As Integer

On Error GoTo ErrHandler

strType = UCase(Trim(ConfigData(i, C_TYPE)))

strRate = Trim(ConfigData(i, C_RATE))

' 种别 为空报错

If strType = "" Then

IsCreateFile = False

Call WriteLog(Log_Error, "ISCREATEFILE", "" & i & E_MESSAGE3)

Exit Function

End If

' 频率 为空报错

If strRate = "" Then

IsCreateFile = False

Call WriteLog(Log_Error, "ISCREATEFILE", "" & i & E_MESSAGE4)

Exit Function

End If

strRateArray = Split(strRate, COMMA)

Select Case strType

Case Type_Day

For j = 0 To UBound(strRateArray)

If strRateArray(j) = 1 Then

ConfigData(i, C_ISCREATE) = "1"

IsCreateFile = True

Exit Function

End If

Next j

Case Type_Week

For j = 0 To UBound(strRateArray)

If strRateArray(j) = g_WeekDay Then

ConfigData(i, C_ISCREATE) = "1"

IsCreateFile = True

Exit Function

End If

Next j

Case Type_Month

For j = 0 To UBound(strRateArray)

If strRateArray(j) = g_Day Then

ConfigData(i, C_ISCREATE) = "1"

IsCreateFile = True

Exit Function

End If

Next j

Case Else

IsCreateFile = False

Call WriteLog(Log_Error, "ISCREATEFILE", E_MESSAGE5 & strType)

Exit Function

End Select

IsCreateFile = False

Exit Function

ErrHandler:

IsCreateFile = False

Call WriteLog(Log_Error, "ISCREATEFILE", Err.Description)

End Function

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

作者的其它热门文章

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