riflemanscar23
New Member
- Joined
- Apr 7, 2014
- Messages
- 1
Hi. I have a problem that I have been banging my head against the wall for a couple of weeks now. What is going on is I am trying to create a macro that will automate the processing of certain files on a daily, weekly or monthly basis so that my operators do not have to touch the files at all. The macro was working fine for both daily and weekly files when it was running under Excel 2003. However, I need to combine the two separate workbooks into one and when I try to streamline the code, it breaks down. I am including a sample of the spreadsheet data and the code for the modules. Any assistance is greatly appreciated. Thank you.
Code - Main:
Option Explicit
Sub RMS_REPORTS()
' Created: 24 January 2014 by Mark Tyler
' Purpose: To automate the actual processing of reports pulled off of the Integrity server. The spreadsheet and macro
' contain the lists of the reports to be processed along with the associated information to store the RMS files and the
' spreadsheets. Created Monarch module for processing the RMS reports into Excel spreadsheets.
' Updated: 10 February 2014 by Mark Tyler
' Added in case statements for DFUNDED.DAT and RTT.DAT. Modified case statement for RTT.DAT to account for three runs
' of Monarch module.
' Create and initialize variables to store the report information from the worksheet. These variables will begtin with
' RPT_ to show they hold report information.
Dim RPT_Name As String
Dim RPT_Source As String
Dim RPT_TempFile As String
Dim RPT_Output As String
Dim RPT_Archive As String
Dim RPT_Model As String
Dim RPT_InfoFile As String
Dim RPT_ArrayHeader(25) As String
Dim Template_WBook As Workbook
Dim Current_WSheet As Worksheet
' Create and initialize variables for the processing of the files. These variables will begin with PROC_ to show they
' are for processing the files.
Dim PROC_FileError As Integer
Dim PROC_RowInd As Integer
Dim PROC_ColInd As Integer
Dim PROC_RowRpt As Integer
Dim PROC_ColRpt As Integer
Dim PROC_ErrorMsg As Integer
Dim PROC_FuncCall As Integer
Dim PROC_LoopCtr As Integer
Dim PROC_FileNotProcessed(14) As String
Dim PROC_CmdLine As String
Dim PROC_ShellWait As Boolean
Dim PROC_Function As Boolean
' Populate the index variables from the active, (i.e. - open), worksheet before calling the module to transfer the files
' off of the Integrity.
PROC_RowInd = 2
PROC_ColInd = 2
ActiveCell(PROC_RowInd, PROC_ColInd).Select
' Populate the script file information so that the correct script can be run and pull the correct information. And
' process the function call to the module.
PROC_CmdLine = Cells(PROC_RowInd, PROC_ColInd)
PROC_ShellWait = F_7_AB_1_ShellAndWaitSimple(PROC_CmdLine)
' Update error counter if function call fails.
If PROC_ShellWait = False Then
PROC_FileError = PROC_FileError + 1
End If
' Set the index variables to point to the first file to process.
PROC_RowInd = 3
PROC_ColInd = 1
' Identify template workbook for return to continue processing.
Set Template_WBook = ActiveWorkbook
' Set up loop to control searching through the spreadsheet.
Do While Cells(PROC_RowInd, PROC_ColInd) <> 999999999
' Advance pointer to next set of report information and populate variables.
PROC_RowRpt = PROC_RowInd
PROC_ColRpt = PROC_ColInd + 1
ActiveCell(PROC_RowRpt, PROC_ColRpt).Select
RPT_Name = Cells(PROC_RowRpt, PROC_ColRpt)
RPT_Source = Cells(PROC_RowRpt + 1, PROC_ColRpt)
RPT_TempFile = Cells(PROC_RowRpt + 2, PROC_ColRpt)
RPT_Output = Cells(PROC_RowRpt + 3, PROC_ColRpt)
RPT_Archive = Cells(PROC_RowRpt + 4, PROC_ColRpt)
RPT_Model = Cells(PROC_RowRpt + 5, PROC_ColRpt)
' Test for column headers and populate if there.
If Cells(PROC_RowRpt + 7, PROC_ColRpt) <> "" Then
For PROC_LoopCtr = 0 To 25
RPT_ArrayHeader(PROC_LoopCtr) = Cells(PROC_RowRpt + 7, PROC_ColRpt + PROC_LoopCtr).Value
Next PROC_LoopCtr
End If
' Case statements to determine how to process the next report.
Select Case RPT_Name
Case "doefund"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
' Call Monarch function to open and convert report to Excel.
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_TempFile, RPT_Model)
End If
' Open output file and add column headers
Workbooks.Open RPT_TempFile
'Range("A1").Select
Call UnprotectAll
' Set column headers
For PROC_LoopCtr = 0 To 25
Cells(1, PROC_LoopCtr) = RPT_ArrayHeader(PROC_LoopCtr)
Next PROC_LoopCtr
Case "dfunded"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
' Call Monarch function to open and convert report to Excel.
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_TempFile, RPT_Model)
End If
Case "rtt"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
RPT_Output = Cells(PROC_RowRpt + 3, PROC_ColRpt + 7)
RPT_Model = Cells(PROC_RowRpt + 5, PROC_ColRpt + 7)
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
RPT_Output = Cells(PROC_RowRpt + 3, PROC_ColRpt + 15)
RPT_Model = Cells(PROC_RowRpt + 5, PROC_ColRpt + 15)
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
End If
Case "trbal"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
End If
Case Else
PROC_ErrorMsg = MsgBox("No files found - Please check that file transfer script ran" + _
"correctly.", vbOKCancel)
End Select
' Clear the variables holding the report information.
RPT_Name = ""
RPT_Source = ""
RPT_TempFile = ""
RPT_Output = ""
RPT_Archive = ""
RPT_Model = ""
For PROC_LoopCtr = 1 To 25
RPT_ArrayHeader(PROC_LoopCtr) = ""
Next PROC_LoopCtr
' Advance row index pointer to next report information in spreadsheet.
PROC_RowInd = PROC_RowInd + 8
ActiveCell(PROC_RowInd, PROC_ColInd).Select
Loop
End Sub
Public Sub ModifyWorkBook(wbName As String, ColHeaders() As String)
' This subroutine will take care of opening and adding the correct headers to each workbook.
Workbooks.Open Filename:=wbName, ReadOnly:=False
Range("A1").Activate
For SubLoopCtr = 1 To Length(ColHeaders)
Cells(1, SubLoopCtr) = ColHeaders(SubLoopCtr)
Next SubLoopCtr
End Sub
' The following subroutines come from John Walkenback's book, "Microsoft Excel 2010 Power Programming with VBA".
Public Sub SaveAllWorkbooks()
Dim book As Workbook
For Each book In Workbooks
If book.Path <> "" Then book.Save
Next book
End Sub
Public Sub CloseAllWorkbooks()
Dim book As Workbook
For Each book In Workbooks
If book.Name <> ThisWorkbook.Name Then
book.Close savechanges:=True
End If
Next book
ThisWorkbook.Close savechanges:=True
End Sub
Public Sub UnprotectAll()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect
Next sh
End Sub
Public Function ProcessMonarch(MON_SOURCE As String, MON_OUTPUT As String, MON_MODEL As String) As Integer
' Created: 24 January 2014 by Mark Tyler
' Purpose: To automate the processing of reports produced in our primary database and output in Excel.
' This function will produce the Excel spreadsheet required for the rest of the processing and if it cannot,
' it will return an error code of '999'.
' MonProc will receive the information from the macro regarding the name of the file to be processed,
' where to find the model, etc. Variables within MonProc are named with MON as the prefix to identify them within the scope
' of this function. These variables are created and assigned when the function gets called by the original routine.
' Dimension local variables used by this function.
Dim MonarchObj As Object ' This creates a Monarch COM server object
Dim OpenFile, OpenMod As Boolean ' Creates boolean variables
' Create and initialize local variables with the required information for using Monarch. The MON_SOURCE file is the
' rms file downloaded from the Integrity and the MON_OUTPUT file is the EXCEL spreadsheet exported by Monarch.
' Check for an open instance of Monarch. If none found, open Monarch via the Monarch COM server object instance.
Set MonarchObj = GetObject("", "Monarch32")
If MonarchObj Is Nothing Then
Set MonarchObj = CreateObject("Monarch32")
End If
' Process file into Excel spreadsheet based on data passed to function originally. Error- catching is added to
' make sure the RMS file exists in the folder. If not, it is skipped and processing continues with the next file.
If Dir(MON_SOURCE) = "" Then
OpenFile = MonarchObj.setReportFile(MON_SOURCE, False)
Else:
OpenFile = MonarchObj.setReportFile(MON_SOURCE, True)
If OpenFile = True Then
OpenMod = MonarchObj.setModelFile(MON_MODEL)
If OpenMod = True Then
MonarchObj.ExportTable (MON_OUTPUT)
Else:
ProcessMonarch = 999
End If
Else:
ProcessMonarch = 999
End If
End If
' Test for an error condition and update the
If (OpenFile = False) Then
ProcessMonarch = 999
Else:
If (OpenMod = False) Then
ProcessMonarch = 999
End If
End If
' Close Monarch
MonarchObj.CloseAllDocuments
End Function
Here is a sample of the information from the main spreadsheet itself:
[TABLE="width: 299"]
<TBODY>[TR]
[TD]doefund</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 4"]i:\Transfers\RMS_REPORTS\doefund.dat</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 4"]i:\Transfers\RMS_REPORTS\dfund.xls</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 4"]I:\Transfers\RMS_REPORTS\04Apr14_DFUND.xls</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 4"]I:\Transfers\RMS_REPORTS\04Apr14_DFUND.DAT</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 3"]i:\Models\M_DFUNDED.xmod</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]MBrCd</SPAN>[/TD]
[TD]Acct Num</SPAN>[/TD]
[TD]Last Name</SPAN>[/TD]
[TD]ColCd</SPAN>[/TD]
[/TR]
</TBODY><COLGROUP><COL><COL span=2><COL></COLGROUP>[/TABLE]
As you can see, the spreadsheet contains the name and location for the data file, the temporary output file and the final archive location for each file. I am trying to set up this format so that I can add or remove files as needed without touching the underlying vba code when I do update the file list.
Code - Main:
Option Explicit
Sub RMS_REPORTS()
' Created: 24 January 2014 by Mark Tyler
' Purpose: To automate the actual processing of reports pulled off of the Integrity server. The spreadsheet and macro
' contain the lists of the reports to be processed along with the associated information to store the RMS files and the
' spreadsheets. Created Monarch module for processing the RMS reports into Excel spreadsheets.
' Updated: 10 February 2014 by Mark Tyler
' Added in case statements for DFUNDED.DAT and RTT.DAT. Modified case statement for RTT.DAT to account for three runs
' of Monarch module.
' Create and initialize variables to store the report information from the worksheet. These variables will begtin with
' RPT_ to show they hold report information.
Dim RPT_Name As String
Dim RPT_Source As String
Dim RPT_TempFile As String
Dim RPT_Output As String
Dim RPT_Archive As String
Dim RPT_Model As String
Dim RPT_InfoFile As String
Dim RPT_ArrayHeader(25) As String
Dim Template_WBook As Workbook
Dim Current_WSheet As Worksheet
' Create and initialize variables for the processing of the files. These variables will begin with PROC_ to show they
' are for processing the files.
Dim PROC_FileError As Integer
Dim PROC_RowInd As Integer
Dim PROC_ColInd As Integer
Dim PROC_RowRpt As Integer
Dim PROC_ColRpt As Integer
Dim PROC_ErrorMsg As Integer
Dim PROC_FuncCall As Integer
Dim PROC_LoopCtr As Integer
Dim PROC_FileNotProcessed(14) As String
Dim PROC_CmdLine As String
Dim PROC_ShellWait As Boolean
Dim PROC_Function As Boolean
' Populate the index variables from the active, (i.e. - open), worksheet before calling the module to transfer the files
' off of the Integrity.
PROC_RowInd = 2
PROC_ColInd = 2
ActiveCell(PROC_RowInd, PROC_ColInd).Select
' Populate the script file information so that the correct script can be run and pull the correct information. And
' process the function call to the module.
PROC_CmdLine = Cells(PROC_RowInd, PROC_ColInd)
PROC_ShellWait = F_7_AB_1_ShellAndWaitSimple(PROC_CmdLine)
' Update error counter if function call fails.
If PROC_ShellWait = False Then
PROC_FileError = PROC_FileError + 1
End If
' Set the index variables to point to the first file to process.
PROC_RowInd = 3
PROC_ColInd = 1
' Identify template workbook for return to continue processing.
Set Template_WBook = ActiveWorkbook
' Set up loop to control searching through the spreadsheet.
Do While Cells(PROC_RowInd, PROC_ColInd) <> 999999999
' Advance pointer to next set of report information and populate variables.
PROC_RowRpt = PROC_RowInd
PROC_ColRpt = PROC_ColInd + 1
ActiveCell(PROC_RowRpt, PROC_ColRpt).Select
RPT_Name = Cells(PROC_RowRpt, PROC_ColRpt)
RPT_Source = Cells(PROC_RowRpt + 1, PROC_ColRpt)
RPT_TempFile = Cells(PROC_RowRpt + 2, PROC_ColRpt)
RPT_Output = Cells(PROC_RowRpt + 3, PROC_ColRpt)
RPT_Archive = Cells(PROC_RowRpt + 4, PROC_ColRpt)
RPT_Model = Cells(PROC_RowRpt + 5, PROC_ColRpt)
' Test for column headers and populate if there.
If Cells(PROC_RowRpt + 7, PROC_ColRpt) <> "" Then
For PROC_LoopCtr = 0 To 25
RPT_ArrayHeader(PROC_LoopCtr) = Cells(PROC_RowRpt + 7, PROC_ColRpt + PROC_LoopCtr).Value
Next PROC_LoopCtr
End If
' Case statements to determine how to process the next report.
Select Case RPT_Name
Case "doefund"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
' Call Monarch function to open and convert report to Excel.
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_TempFile, RPT_Model)
End If
' Open output file and add column headers
Workbooks.Open RPT_TempFile
'Range("A1").Select
Call UnprotectAll
' Set column headers
For PROC_LoopCtr = 0 To 25
Cells(1, PROC_LoopCtr) = RPT_ArrayHeader(PROC_LoopCtr)
Next PROC_LoopCtr
Case "dfunded"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
' Call Monarch function to open and convert report to Excel.
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_TempFile, RPT_Model)
End If
Case "rtt"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
RPT_Output = Cells(PROC_RowRpt + 3, PROC_ColRpt + 7)
RPT_Model = Cells(PROC_RowRpt + 5, PROC_ColRpt + 7)
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
RPT_Output = Cells(PROC_RowRpt + 3, PROC_ColRpt + 15)
RPT_Model = Cells(PROC_RowRpt + 5, PROC_ColRpt + 15)
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
End If
Case "trbal"
PROC_Function = IsFileThere(RPT_Source)
If PROC_Function = True Then
PROC_FuncCall = ProcessMonarch(RPT_Source, RPT_Output, RPT_Model)
End If
Case Else
PROC_ErrorMsg = MsgBox("No files found - Please check that file transfer script ran" + _
"correctly.", vbOKCancel)
End Select
' Clear the variables holding the report information.
RPT_Name = ""
RPT_Source = ""
RPT_TempFile = ""
RPT_Output = ""
RPT_Archive = ""
RPT_Model = ""
For PROC_LoopCtr = 1 To 25
RPT_ArrayHeader(PROC_LoopCtr) = ""
Next PROC_LoopCtr
' Advance row index pointer to next report information in spreadsheet.
PROC_RowInd = PROC_RowInd + 8
ActiveCell(PROC_RowInd, PROC_ColInd).Select
Loop
End Sub
Public Sub ModifyWorkBook(wbName As String, ColHeaders() As String)
' This subroutine will take care of opening and adding the correct headers to each workbook.
Workbooks.Open Filename:=wbName, ReadOnly:=False
Range("A1").Activate
For SubLoopCtr = 1 To Length(ColHeaders)
Cells(1, SubLoopCtr) = ColHeaders(SubLoopCtr)
Next SubLoopCtr
End Sub
' The following subroutines come from John Walkenback's book, "Microsoft Excel 2010 Power Programming with VBA".
Public Sub SaveAllWorkbooks()
Dim book As Workbook
For Each book In Workbooks
If book.Path <> "" Then book.Save
Next book
End Sub
Public Sub CloseAllWorkbooks()
Dim book As Workbook
For Each book In Workbooks
If book.Name <> ThisWorkbook.Name Then
book.Close savechanges:=True
End If
Next book
ThisWorkbook.Close savechanges:=True
End Sub
Public Sub UnprotectAll()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect
Next sh
End Sub
Public Function ProcessMonarch(MON_SOURCE As String, MON_OUTPUT As String, MON_MODEL As String) As Integer
' Created: 24 January 2014 by Mark Tyler
' Purpose: To automate the processing of reports produced in our primary database and output in Excel.
' This function will produce the Excel spreadsheet required for the rest of the processing and if it cannot,
' it will return an error code of '999'.
' MonProc will receive the information from the macro regarding the name of the file to be processed,
' where to find the model, etc. Variables within MonProc are named with MON as the prefix to identify them within the scope
' of this function. These variables are created and assigned when the function gets called by the original routine.
' Dimension local variables used by this function.
Dim MonarchObj As Object ' This creates a Monarch COM server object
Dim OpenFile, OpenMod As Boolean ' Creates boolean variables
' Create and initialize local variables with the required information for using Monarch. The MON_SOURCE file is the
' rms file downloaded from the Integrity and the MON_OUTPUT file is the EXCEL spreadsheet exported by Monarch.
' Check for an open instance of Monarch. If none found, open Monarch via the Monarch COM server object instance.
Set MonarchObj = GetObject("", "Monarch32")
If MonarchObj Is Nothing Then
Set MonarchObj = CreateObject("Monarch32")
End If
' Process file into Excel spreadsheet based on data passed to function originally. Error- catching is added to
' make sure the RMS file exists in the folder. If not, it is skipped and processing continues with the next file.
If Dir(MON_SOURCE) = "" Then
OpenFile = MonarchObj.setReportFile(MON_SOURCE, False)
Else:
OpenFile = MonarchObj.setReportFile(MON_SOURCE, True)
If OpenFile = True Then
OpenMod = MonarchObj.setModelFile(MON_MODEL)
If OpenMod = True Then
MonarchObj.ExportTable (MON_OUTPUT)
Else:
ProcessMonarch = 999
End If
Else:
ProcessMonarch = 999
End If
End If
' Test for an error condition and update the
If (OpenFile = False) Then
ProcessMonarch = 999
Else:
If (OpenMod = False) Then
ProcessMonarch = 999
End If
End If
' Close Monarch
MonarchObj.CloseAllDocuments
End Function
Here is a sample of the information from the main spreadsheet itself:
[TABLE="width: 299"]
<TBODY>[TR]
[TD]doefund</SPAN>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 4"]i:\Transfers\RMS_REPORTS\doefund.dat</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 4"]i:\Transfers\RMS_REPORTS\dfund.xls</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 4"]I:\Transfers\RMS_REPORTS\04Apr14_DFUND.xls</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 4"]I:\Transfers\RMS_REPORTS\04Apr14_DFUND.DAT</SPAN>[/TD]
[/TR]
[TR]
[TD="colspan: 3"]i:\Models\M_DFUNDED.xmod</SPAN>[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]MBrCd</SPAN>[/TD]
[TD]Acct Num</SPAN>[/TD]
[TD]Last Name</SPAN>[/TD]
[TD]ColCd</SPAN>[/TD]
[/TR]
</TBODY><COLGROUP><COL><COL span=2><COL></COLGROUP>[/TABLE]
As you can see, the spreadsheet contains the name and location for the data file, the temporary output file and the final archive location for each file. I am trying to set up this format so that I can add or remove files as needed without touching the underlying vba code when I do update the file list.
