We help IT Professionals succeed at work.

Automate adding+executing an excel macro to multiple files

939 Views
Last Modified: 2010-05-18
I'm trying to write a small console app that will ultimately loop through a bunch of files in a directory, and execute the macro code stored in RefundValidationFormat.cls. I can do this manually by using Excel's Tools->Macros->Visual Basic Editor->Import and select this file.

Currently I just have the code set up to work on one file, but it's throwing an error as the Run command is usually used to execute a macro that already exists.
Imports Microsoft.Office.Interop.Excel
 
Module cmgTableFormat
 
    Sub Main()
        Dim currDirectory As New IO.DirectoryInfo(CurDir())
        Dim oExcel As ApplicationClass
        Dim oBook As WorkbookClass
        Dim oBooks As Workbooks
        Dim missing As Object = System.Reflection.Missing.Value
 
 
        'Start Excel and open the workbook.
 
        oExcel = DirectCast(CreateObject("Excel.Application"), Application)
        oExcel.Visible = False
        oBooks = oExcel.Workbooks
        oBook = oBooks.Open(CurDir() + "\Refund Validation Table - 0-100 Filtered.xls", missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
 
        'running the macro
        oExcel.Run(CurDir() + "\RefundValidationFormat.cls")
 
        'Clean-up: Close the workbook and quit Excel.
        oBook.Close(False)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(oBook)
        oBook = Nothing
        System.Runtime.InteropServices.Marshal.ReleaseComObject(oBooks)
        oBooks = Nothing
        oExcel.Quit()
        System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcel)
        oExcel = Nothing
    End Sub
 
End Module

Open in new window

Comment
Watch Question

Grand Poobah
CERTIFIED EXPERT
Most Valuable Expert 2011
Top Expert 2011
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION

Author

Commented:
Sounds like a great idea!

The only thing I'm hesitant about is how much of this code I can convert into VB.NET code.

The code below is the function once I brought it into my project. I also pasted the "oExcel" where I was getting errors.

However, there are a bunch of references to objects begining with "xl" and an "Array" around the 18th line that I'm not sure how to convert.
    Sub RefundValidationFormat(ByRef oExcel As ApplicationClass)
        '
        ' RefundValidationFormat Macro
        ' Macro recorded 6/19/2008 by irp7257
        '
        oExcel.Cells.Select()
        With oExcel.Selection.Font
            .Name = "Arial"
            .Size = 8
        End With
        oExcel.Range("D2").Select()
        oExcel.Range("A1", oExcel.ActiveCell.SpecialCells(xlLastCell)).Sort(Key1:=oExcel.Range("A2"), Order1:=xlAscending, Key2:= _
            oExcel.Range("C2"), Order2:=xlAscending, Key3:=oExcel.Range("D2"), Order3:=xlAscending _
            , Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
            xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
            DataOption3:=xlSortNormal)
        oExcel.Selection.Subtotal(GroupBy:=3, Function:=xlSum, TotalList:=Array(14, 15, 16 _
            , 17, 18, 19), Replace:=True, PageBreaks:=False, SummaryBelowData:=True)
        'Range("S2").Select
        'ActiveCell.Formula = "=IF(B2 = """", (Q2+R2),"""")"
        'Range("S2").Select
        'Selection.Copy
        'Range(Selection, Selection.End(xlDown)).Select
        'Range("S2:S4870").Select
        'ActiveSheet.Paste
        oExcel.Range("Y2").Select()
        oExcel.ActiveCell.Formula = "=IF(B2 = """", (N2+O2+P2+Q2)-(S2),"""")"
        oExcel.Selection.Copy()
        oExcel.Range(oExcel.Selection, oExcel.ActiveCell.SpecialCells(xlLastCell)).Select()
        oExcel.ActiveSheet.Paste()
        oExcel.Range("Y1").Select()
        oExcel.Application.CutCopyMode = False
        oExcel.ActiveCell.FormulaR1C1 = "Difference"
        oExcel.Rows("2:2").Select()
        oExcel.Selection.FormatConditions.Delete()
        oExcel.Selection.FormatConditions.Add(Type:=xlExpression, Formula1:="=$B2=""*""")
        oExcel.Selection.FormatConditions(1).Interior.ColorIndex = 36
        oExcel.Selection.FormatConditions.Add(Type:=xlExpression, Formula1:="=$B2=""""")
        With oExcel.Selection.FormatConditions(2).Font
            .Bold = True
            .Italic = False
        End With
        oExcel.Selection.Copy()
        oExcel.Cells.Select()
        'Range("A2:X2").Select
        oExcel.Selection.PasteSpecial(Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False)
        oExcel.ActiveWindow.SmallScroll(ToRight:=5)
        'Range("S2").Select
        'Application.CutCopyMode = False
        'Selection.FormatConditions.Delete
        'Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=""*"""
        'Selection.FormatConditions(1).Interior.ColorIndex = 36
        'Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$B2="""""
        'Selection.FormatConditions(2).Interior.ColorIndex = 35
        'With Selection.FormatConditions(2).Font
        '    .Bold = True
        '    .Italic = False
        'End With
        'Selection.Copy
        'Columns("S:S").Select
        'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        '    SkipBlanks:=False, Transpose:=False
        'Application.CutCopyMode = False
        oExcel.Rows("1:1").Select()
        oExcel.Selection.Font.Bold = True
        oExcel.Selection.Interior.ColorIndex = 15
        oExcel.Selection.Rows.AutoFit()
        oExcel.Selection.AutoFilter()
        oExcel.Rows("2:2").Select()
        oExcel.ActiveWindow.FreezePanes = True
        'Cells.Select
        oExcel.Range("A1").Select()
        oExcel.Range(oExcel.Selection, oExcel.ActiveCell.SpecialCells(xlLastCell)).Select()
        oExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        oExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With oExcel.Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With oExcel.Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With oExcel.Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With oExcel.Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With oExcel.Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With oExcel.Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        oExcel.Columns("F:F").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
        oExcel.Columns("G:G").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
        oExcel.Columns("H:H").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
        oExcel.Columns("I:I").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
        oExcel.Columns("U:U").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
        oExcel.Columns("V:V").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
        oExcel.Columns("W:W").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
        oExcel.Columns("X:X").Select()
        oExcel.Selection.NumberFormat = "m/d/yyyy"
    End Sub

Open in new window

Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.