Excel Macro not executing from Oracle Forms

Hi,
I am trying to open a Excel file from Oracle Forms, this excel file has macro coded in it, so the intention is to just open the Excel file, hoping that just opening of Excel file will execute the macro.

I am using OLE in Oracle Forms, When i coded to just open the Excel file no output file is generated.
So I did some modification in my OLE code, and wrote some value at a particular position in the Excel file containing the Macro, saved it and closed it.

So I could open, write and save this file, but I was surprised that Macro in this file didnt execute!

Am I missing anything in this? Just opening of Excel file wont execute the macro?

Can anyone help me in this regard?

Thanks!
Avinash.
Pune - India.

Hello bavinash05,

You would need to post the Excel macro before anyone could answer your question as to why the macro isn't running. If the macro code is Ok then the problem may lie in the OLE code.

Sincerely,
Leith Ross

Following is the code i have written in Excel Macro -


Dim path, s, sheet_name, MyColumnLetter, del, CellValue, WholeLine As String
Dim rFoundCell, rFound, ligneRange, Cell, RangeOfStyles As Range
Dim last_row, Iloop, Numrows, cRow, cRow2, cCol, row_num, intRet, StartCol, EndCol As Integer
Dim lignesEgales, foundDuplicate As Boolean
Dim styT As Style

Sub auto_open()
'We turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False


dest = "input.txt"
path = "C:\cmm_forecast\"

'open the text file which will contain the path and name of excel file
Open (path + dest) For Input Access Read As #1
While Not EOF(1)
Line Input #1, path
Line Input #1, dest
Wend
Close #1


If dest = "326025.xls" Or dest = "326035.xls" Or dest = "327218.xls" Or dest = "327232.xls" Then
EQTOT_DEV_DEVFPD path:="C:\cmm_forecast\", dest:="326025.xls"
End If
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

'Save workbook
ActiveWorkbook.SaveAs Filename:= _
"C:\cmm_forecast\" + "result_new.csv", FileFormat:= _
xlCSV, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

ActiveWorkbook.Close (False)
Application.DisplayAlerts = False
Application.Quit

End Sub


Sub EQTOT_DEV_DEVFPD(path As String, dest As String)

Workbooks.Open (path + dest), UpdateLinks:=0
Workbooks(dest).Activate
Application.DisplayAlerts = False
Worksheets("EQTOT").Select
Cells(1, 1).Select
Set rFound = ActiveSheet.UsedRange
Set rFoundCell = rFound.Find(What:="CODE", After:=rFound.Cells(rFound.Cells.Count), LookAt:=xlWhole)
Range(rFoundCell, Range(rFoundCell.Address).End(xlToRight).Address).Select
Selection.Copy

Workbooks.Add
Windows("Book1").Activate
Rows("1:1").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False

Workbooks(dest).Activate
Application.DisplayAlerts = False
Worksheets("EQTOT").Select

'Copy data from all sheets uptil DEV into new workbook
Do Until (ActiveSheet.Name = "DEV" Or ActiveSheet.Name = "DEV_FPD")

Cells(1, 1).Select
Set rFound = ActiveSheet.UsedRange
Set rFoundCell = rFound.Find(What:="CODE", After:=rFound.Cells(rFound.Cells.Count), LookAt:=xlWhole)
s = Range(rFoundCell.Address).End(xlToRight).Address

Range(rFoundCell.Address).Select

'extract the column letter from the address of right most cell
MyColumnLetter = Mid(s, 2, (InStr(2, s, "$")) - 2)

'Select cell where "CODE" is found and cells to the right
Range(rFoundCell.Offset(2, 0).Address, Cells(Cells.Rows.Count, MyColumnLetter).End(xlUp).Address).Select

Selection.Copy
sheet_name = ActiveSheet.Name
Windows("Book1").Activate
Rows("1:1").Select
last_row = Cells.SpecialCells(xlLastCell).row
Cells(last_row + 1, "A").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Workbooks(dest).Activate
Worksheets(sheet_name).Select
ActiveSheet.Next.Select
Loop
Windows("Book1").Activate

'Delete hyperlinks if any
ActiveSheet.Hyperlinks.Delete

'Delete formats if any
Range("A1").Select
Cells.Select
Selection.NumberFormat = "General"
Selection.NumberFormat = "0.00000000000000000000"


'Apply same font and style throughout the sheet
Cells(2, "A").Select
Selection.Copy
Columns("A:O").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Columns.AutoFit

'Delete blank rows
Range("A1").Select
Cells.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each rFound In Selection.Rows
If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then
Selection.EntireRow.Delete
End If
Next rFound

'Delete duplicate rows
Numrows = Cells(Rows.Count, "A").End(xlUp).row
Range("A2:O2").Select

'Sort all rows on VIC Code
Range("A1:O1", Cells(Numrows, "B")).Sort _
Key1:=Range("A1:O1"), Order1:=xlAscending, _
Key2:=Range("B1"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom


'Actual loop which does deletion of duplicate rows
For Iloop = Numrows To 2 Step -1
Set ligneRange = Range("A2:O2").Offset(Iloop - 1, 0)
lignesEgales = True
For Each c In ligneRange
If Trim(c.Value) <> Trim(c.Offset(-1, 0).Value) Then
lignesEgales = False
Exit For
End If
Next c
If lignesEgales Then
Rows(Iloop).Delete
End If
Next Iloop

'This will log in log file duplicate VIC with different sales
Open (path + "out.txt") For Output As #1
For row_num = 2 To Numrows
If Trim(Cells(row_num, 1).Value) = Trim(Cells(row_num + 1, 1).Value) Then
If CellValue <> Trim(Cells(row_num + 1, 1).Value) Then
Print #1, Left(Cells(row_num, 1).Value, Len(Cells(row_num, 1).Value))
CellValue = Trim(Cells(row_num + 1, 1).Value)
End If
End If
Next row_num
Close #1



End Sub

I am new to VBA coding, infact i am doing it for first time.
Am I going wrong somewhere?

Thanks,
Avinash.
Pune- India.