Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Problem (Compatibility?) on excel automation [macro] with MS Office Professional Plus 2021 2

Status
Not open for further replies.
gryff15

gryff15

Programmer
Sep 21, 2016
47
PH
Some users encounter problems with excel output using Office 2021. Sometimes, the system hang, then a window pops up:
This action cannot be completed because the other program is busy. Choose 'Switch To' to activate the busy program and correct the problem. [Switch To...][Retry]

What could be the problem? Could it be that the macro codes are not compatible anymore? I used the following variables:

Code: 
#Define xlEdgeBottom 9
#Define xlEdgeLeft 7
#Define xlEdgeRight 10
#Define xlEdgeTop 8
#Define xlDiagonalDown 5
#Define xlDiagonalUp 6
#Define xlNone -4142
#Define xlThin 2
#Define xlContinuous 1
#Define xlInsideHorizontal 12
#Define xlInsideVertical 11
#Define xlCenter -4108
#Define xlBottom -4107
#Define xlContext -5002
#Define xlRight -4152
#Define xlUnderlineStyleNone -4142
#Define xlLandscape 2
#Define xlAutomatic -4105
#Define xlSolid 1
#Define xlThemeColorDark1 1

Could it be that the integer values have different values in Office 2021?


- gryff15 -
 
Sort by date Sort by votes
It might be that they don't have Office installed locally - and are using the 365 internet based system?

You haven't really given us enough information to postulate further

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

There is no place like G28 X0 Y0 Z0
​
 
Upvote 0 Downvote
No, it is nothing to do with integer values, nor to do with macros. And it is not specific to Office 2021 or to VFP.

The message usually crops up when you have an instance of the target application (Excel in this case) running as a COM server and another running interactively, and there is clash of some kind whdn you try to access them both at the same time. I can't give you a more specific answer, but I find I can usually cure it by closing one or other of the instances.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads
 
Upvote 0 Downvote
You might be able to fix it with _vfp.AutoYield or usage of _vfp.OLEServerBusyRaiseError, _vfp.OLEServerBusyTimeout and _vfp.OLERequestPendingTimeout. Read into this and you realize how Mike is correct about stating that these messages only occur when OLE components are involved and they deadlock in some way. The deadlock can also be between VFP and one OLE object, i.e. it can also happen with just one Automation object or Excel.Application or with an ActiveX control.

Setting these properties is no magic recipe for any case. To debug your case I therefore recommend before starting to play with these things make your Excel.Application visible for debugging the case. Automation will slow down with a visible Excel window, but you may find what's blocking. It may hang on a message displayed.

But to showcase how this message is coming up, compile this into a COM Server and create an instance of it with CREATEOBJECT("yourexe.OLEblocking"):

Code: 
Define OLEblocking as session Olepublic
   Procedure Init()
      Read Events
   Endproc 
Enddefine

You'll see the message with [Switch To...][Retry] and a disabled [Cancel} button appears. In case of this READ EVENTS blocking all further execution in VFP, neither waiting nor any setting of both timeouts and RaiseError helps, actually. It's simply Read Events not returning that's causing a deadlock, usually a block may also resolve itself, if it's just a long running process.

If you see any message popup there might be ways to avoid it by avoiding the reason causing the message or by a suppression mechanism. Like you can suppress some alerts with the Application.DisplayAlerts setting. Als don't try that first, you never know what messages you suppress. It's a bad decision that in Ole Automation some things still cause the display of alerts instead of triggering error in the process automating Excel, which would make problems far easier to detect and fix. And if it really simply runs long it helps users see it to stay patient, even if they wait longer. I even had users say: Wow, this is fast. Well, how easy are users impressed on something appearing faster than you can type, but are not at all impressed when something just appears at one moment after a short waiting time.

PS: It can also sometimes help to do some automation tasks with VBS inside an Excel template, though Macro execution is harder for security reasons than automating. Quite inconsequential, if you ask me, as automation gives you even more possibilities to do things with the help of the code automating the ole server than the internal VBA can.

Chriss
 
Upvote 0 Downvote
Hi, this is pretty much the skeleton version of my code after deleting a bunch of formatting.
I put wait windows to see where it starts to hang.
It hangs on:
[ul]
[li]Wait Window 'Creating object excel file...' Nowait[/li]
[li]Wait Window 'Print size setup...' Nowait[/li]
[li]Wait Window 'Column width setup...' Nowait[/li]
[/ul]

Code: 
Set Deleted On
Go Top

*!* ------------ Document Type combo box ----------- ***
Wait Window 'Generating excel file...' Nowait

lcPath = 'C:\test\'

lcFilename = lcPath + gcID

*--------------------------------------------------------****

#Define xlEdgeBottom 9
#Define xlEdgeLeft 7
#Define xlEdgeRight 10
#Define xlEdgeTop 8
#Define xlDiagonalDown 5
#Define xlDiagonalUp 6
#Define xlNone -4142
#Define xlThin 2
#Define xlContinuous 1
#Define xlInsideHorizontal 12
#Define xlInsideVertical 11
#Define xlCenter -4108
#Define xlBottom -4107
#Define xlContext -5002
#Define xlRight -4152
#Define xlUnderlineStyleNone -4142
#Define xlLandscape 2
#Define xlAutomatic -4105
#Define xlSolid 1
#Define xlThemeColorDark1 1

Wait Window 'Creating object excel file...' Nowait

oXLS = Createobject("Excel.Application")

With oXLS
	oWB = .WorkBooks.Add

	.Cells.Select
	.Selection.Font.Size = 11
	.Range("A4:J4").Select


	With .Selection.Interior
		.Pattern = xlSolid
		.PatternColorIndex = xlAutomatic
		.Color = 5222219
		.TintAndShade = 0
		.PatternTintAndShade = 0
	Endwith
	With .Selection.Font
		.ThemeColor = xlThemeColorDark1
		.TintAndShade = 0
		.Bold = .T.
	Endwith

	Wait Window 'Title fields...' Nowait
*!* -------- Title fields ------
*
	.Range("A1").Select
	.ActiveCell.FormulaR1C1 = gcCompany
	.Selection.Font.Bold = .T.
	.Range("A2").Select
	.ActiveCell.FormulaR1C1 = gcTitle
	.Selection.Font.Bold = .T.

	.Range("A4").Select
	.ActiveCell.FormulaR1C1 = "NO."
	.Range("B4").Select
	.ActiveCell.FormulaR1C1 = "DATE"
	.Range("C4").Select
	.ActiveCell.FormulaR1C1 = "AMOUNT"
	.Range("D4").Select
	.ActiveCell.FormulaR1C1 = "CODE"
	.Range("E4").Select
	.ActiveCell.FormulaR1C1 = "NAME"
	.Range("F4").Select
	.ActiveCell.FormulaR1C1 = "COMPANY"
	.Range("G4").Select
	.ActiveCell.FormulaR1C1 = "DUE DATE"
	.Range("H4").Select
	.ActiveCell.FormulaR1C1 = "TYPE")
	.Range("I4").Select
	.ActiveCell.FormulaR1C1 = "REMARKS"
	.Range("J1").Select
	.ActiveCell.FormulaR1C1 = gcID
	.Range("J1").Select
	With .Selection
		.HorizontalAlignment = xlRight
		.VerticalAlignment = xlBottom
		.Orientation = 0
		.AddIndent = .F.
		.IndentLevel = 0
		.ShrinkToFit = .F.
		.ReadingOrder = xlContext
	Endwith

	Wait Window 'ID barcode...' Nowait
*!*	------- ID barcode ----------
*
	.Range("H2").Select
	.ActiveCell.FormulaR1C1 = "*"+gcID+"*"
	.Range("H2:J3").Select
	With .Selection
		.HorizontalAlignment = xlCenter
		.VerticalAlignment = xlCenter
		.WrapText = .F.
		.Orientation = 0
		.AddIndent = .F.
		.IndentLevel = 0
		.ShrinkToFit = .F.
		.ReadingOrder = xlContext
		.MergeCells = .F.
	Endwith
	.Selection.Merge
	With .Selection
		.HorizontalAlignment = xlCenter
		.VerticalAlignment = xlCenter
		.WrapText = .F.
		.Orientation = 0
		.AddIndent = .F.
		.IndentLevel = 0
		.ShrinkToFit = .F.
		.ReadingOrder = xlContext
		.MergeCells = .T.
	Endwith
	With .Selection
		.HorizontalAlignment = xlRight
		.VerticalAlignment = xlCenter
		.WrapText = .F.
		.Orientation = 0
		.AddIndent = .F.
		.IndentLevel = 0
		.ShrinkToFit = .F.
		.ReadingOrder = xlContext
		.MergeCells = .T.
	Endwith
	With .Selection.Font
		.Name = "3 of 9 Barcode"
		.Size = 22
		.Strikethrough = .F.
		.Superscript = .F.
		.Subscript = .F.
		.OutlineFont = .F.
		.Shadow = .F.
		.Underline = xlUnderlineStyleNone
		.TintAndShade = 0
	Endwith

	Wait Window 'Aligning title fields to center...' Nowait
*!*	-------- Aligning title fields to center --------
*
	.Range("A4:J4").Select
	With .Selection
		.HorizontalAlignment = xlCenter
		.VerticalAlignment = xlBottom
		.Orientation = 0
		.IndentLevel = 0
		.ShrinkToFit = .F.
		.ReadingOrder = xlContext
		.MergeCells = .F.
	Endwith

	Wait Window 'Print size setup...' Nowait
*!*	-------- Print size setup -------
*
	With .ActiveSheet.PageSetup
		.LeftMargin = .Application.InchesToPoints(0.30)
		.RightMargin = .Application.InchesToPoints(0.25)
		.TopMargin = .Application.InchesToPoints(0.2)
		.BottomMargin = .Application.InchesToPoints(0.05)
		.HeaderMargin = .Application.InchesToPoints(0.2)
		.FooterMargin = .Application.InchesToPoints(0)
		.CenterHorizontally = .T.
		.Orientation = xlLandscape
		.FitToPagesWide = 1
		.FitToPagesTall = .F.
		.Zoom = .F.
		.ScaleWithDocHeaderFooter = .T.
		.AlignMarginsHeaderFooter = .T.
	Endwith
*--------------------------------------------------------****


	Wait Clear
	lcCellNo = Alltrim('5') && Initial cell position of data
	Go Top

	Wait Window 'Looping the data from table...' Nowait
*!* ------- LOOPING THE DATA FROM THE TABLE -----
*
	Do While !Eof()


		Wait Window 'Insertion of data...'+Alltrim(Str(lnCurrentRecord)) Nowait
*!*	------ Insertion of data
		.Range("A"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = num
		.Range("B"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = Ttod(gcdate)
		.Range("C"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = amount
		.Selection.Style = "Comma"
		.Range("D"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = Alltrim(Code)
		.Range("E"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = Alltrim(Name)
		.Selection.WrapText = .T.
		.Range("F"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = Alltrim(company)
		.Selection.WrapText = .T.

		Select prinfo

		.Range("G"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = Ttod(duedate)

		.Range("H"+lcCellNo ).Select
		.ActiveCell.FormulaR1C1 = Alltrim(Type)

		.Range("I"+lcCellNo).Select
		.ActiveCell.FormulaR1C1 = Alltrim(remarks)


		.Selection.WrapText = .T.

		.Range("J"+lcCellNo ).Select
		.Selection.Font.Name = "3 of 9 Barcode"
		.Selection.Font.Size = 18
		.ActiveCell.FormulaR1C1 = "*"+Alltrim(num)+"*"

*------------------------------------------------***


*!* ------- Set font size of records to 8
		.Range("A"+lcCellNo+":I"+lcCellNo).Select
		With .Selection.Font
			.Name = "Calibri"
			.Size = 8
			.Underline = xlUnderlineStyleNone
			.TintAndShade = 0
		Endwith

*!* ------ Increase height of row records and align middle
		.Range("A"+lcCellNo+":J"+lcCellNo).Select
		.Rows(lcCellNo+":"+lcCellNo).RowHeight = 18
		.Range("A"+lcCellNo+":J"+lcCellNo).Select
		With .Selection
			.VerticalAlignment = xlCenter
		Endwith

*!*	------ Align to center
		.Range("A"+lcCellNo+",B"+lcCellNo+",D"+lcCellNo+",G"+lcCellNo+",H"+lcCellNo+",I"+lcCellNo+",J"+lcCellNo).Select
		.Range("J"+lcCellNo).Activate
		With .Selection
			.HorizontalAlignment = xlCenter
		Endwith
		.Rows(lcCellNo+":"+lcCellNo).EntireRow.AutoFit

		lcCellNo = Alltrim(Str(Val(lcCellNo) + 1))
		lnCurrentRecord = lnCurrentRecord + 1

		Skip

	Enddo
*--------------------------------------------------------****

	Wait Window 'Footer display...' Nowait
*!*	------ FOOTER: Display of total records and total 'amount' at the end of the report ------
*
	.Range("A"+lcCellNo+":J"+lcCellNo).Select
	.Selection.RowHeight = 4

	lcCellNo = Alltrim(Str(Val(lcCellNo) + 1))
	Sum amount To lnTotalAmt

	.Range("A"+lcCellNo+":J"+lcCellNo).Select
	.Selection.Font.Size = 8

	.Range("A"+lcCellNo).Select
	.ActiveCell.FormulaR1C1 = "TOTAL"
	.Selection.HorizontalAlignment = xlCenter
	.Range("B"+lcCellNo).Select
	.ActiveCell.FormulaR1C1 = lnSum
	.Selection.HorizontalAlignment = xlCenter
	.Range("C"+lcCellNo).Select
	.ActiveCell.FormulaR1C1 = lnTotalAmt
	.Selection.Style = "Comma"
	.Range("J"+lcCellNo).Select
	.ActiveCell.FormulaR1C1 = "DATE   "+Transform(Datetime())
	.Selection.HorizontalAlignment = xlRight
*--------------------------------------------------------****

	Wait Window 'Line borders at the end of the report...' Nowait
*!*	------ Line borders of the end of report -----
*
	.Range("A"+lcCellNo+":J"+lcCellNo).Select
	.Selection.BorderS(xlDiagonalDown).LineStyle = xlNone
	.Selection.BorderS(xlDiagonalUp).LineStyle = xlNone
	.Selection.BorderS(xlEdgeLeft).LineStyle = xlNone
	With .Selection.BorderS(xlEdgeTop)
		.LineStyle = xlContinuous
		.ColorIndex = 0
		.TintAndShade = 0
		.Weight = xlThin
	Endwith
	.Selection.BorderS(xlEdgeBottom).LineStyle = xlNone
	.Selection.BorderS(xlEdgeRight).LineStyle = xlNone
	.Selection.BorderS(xlInsideVertical).LineStyle = xlNone
	.Selection.BorderS(xlInsideHorizontal).LineStyle = xlNone
	.Selection.BorderS(xlDiagonalDown).LineStyle = xlNone
	.Selection.BorderS(xlDiagonalUp).LineStyle = xlNone
	.Selection.BorderS(xlEdgeLeft).LineStyle = xlNone
	With .Selection.BorderS(xlEdgeTop)
		.LineStyle = xlContinuous
		.ColorIndex = 0
		.TintAndShade = 0
		.Weight = xlThin
	Endwith
	With .Selection.BorderS(xlEdgeBottom)
		.LineStyle = xlContinuous
		.ColorIndex = 0
		.TintAndShade = 0
		.Weight = xlThin
	Endwith
	.Selection.BorderS(xlEdgeRight).LineStyle = xlNone
	.Selection.BorderS(xlInsideVertical).LineStyle = xlNone
	.Selection.BorderS(xlInsideHorizontal).LineStyle = xlNone

	Wait Window 'Column width setup...' Nowait
*!* --------	Column widths setup ---------
*
	.Columns("A:A").ColumnWidth = 11.43
	.Columns("B:B").ColumnWidth = 8.71
	.Columns("C:C").ColumnWidth = 10.63
	.Columns("D:D").ColumnWidth = 19.29
	.Columns("E:E").ColumnWidth = 28
	.Columns("F:F").ColumnWidth = 28
	.Columns("G:G").ColumnWidth = 8.71
	.Columns("H:H").ColumnWidth = 10.86
	.Columns("I:I").ColumnWidth = 20
	.Columns("J:J").ColumnWidth = 31

	Wait Window 'Locking columns...' Nowait
*!*	------- Lock columns --------
	.Cells.Select
	.Selection.Locked = .F.
	.Selection.FormulaHidden = .F.
	.Columns("A:H").Select
	.Selection.Locked = .T.
	.Selection.FormulaHidden = .F.
	.ActiveSheet.Protect
	.Range("A1").Select

*--------------------------------------------------------****

	Wait Window 'Saving excel file...' Nowait
*!*	------ Saving excel file -----
*
	Thisform.labelsavingDot.Caption = "Saving complete!"
	.ActiveWorkBook.SaveAs(lcFilename)

	Messagebox(lcSaveSuccess+Chr(13)+Chr(10)+"Number of records processed: "+Alltrim(Str(lnSum)),0+64,"SUCCESS")

	If Messagebox("Saved to "+lcPath+Chr(13)+Chr(10)+Chr(13)+Chr(10)+"Do you want to open the file?",4+32,Juststem(lcFilename)+".xlsx") = 6
		.Visible = .T.
		.WindowState = 2  && wdWindowStateMinimize
		.WindowState = 1  && wdWindowStateMaximize
		.WindowState = 3
	Else
		.Quit
	Endif


Endwith
Release oXLS
Wait Window 'Others...' Nowait
*!*	***** ---- Just in case something happened when saving the excel and it failed *****
If Adir(laGarbage,lcFilename+".xlsx") = 0
	Messagebox(lcSaveFailed,0+16,"Excel Output Failed")
Endif
************************************************************************************

Set Deleted Off


- gryff15 -
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

ravicoder
  • Locked
  • Question
excel automation printing to pdf error
Replies
8
Views
371
combo
combo
ravicoder
  • Locked
  • Question
Generating graphs using excel automation
Replies
1
Views
149
TamarGranor
TamarGranor
ravicoder
  • Locked
  • Question
Using the Union Method of excel automation
Replies
3
Views
159
Mike Lewis
Mike Lewis
sdocker
  • Locked
  • Question
Email automation with OUTLOOKNEW
Replies
10
Views
346
Mike Lewis
Mike Lewis
JackTheC
  • Locked
  • Question
Office Automation of a specific version 1
2
Replies
21
Views
401
Chris Miller
Chris Miller

Part and Inventory Search

Sponsor

Back
Top