I am getting an Automation error, when Catia is trying to write values in a selected Excel sheet. It's a bit confusing because on the first try of the code there was no error and the values were in the Excel sheet.
I didn't change the code, but on the second try I get:
Run-time error '-2147417846 (8001010a)': Automation error
"The Message filter indicated that the application is busy."
on the line: Set MyXL = GetObject(FPath)
Sub CATMain()
FPath = CATIA.FileSelectionBox("Select the Excel file you wish to put the value in", "*.xlsx", CatFileSelectionModeOpen)
If FPath = "" Then
Exit Sub
End If
Set xlApp = CreateObject("Excel.Application")
Set MyXL = GetObject(, "Excel.Application")
Set MyXL = GetObject(FPath)
MyXL.Application.Visible = True
MyXL.Parent.Windows(1).Visible = True
Dim oSelection As Selection
Set oSelection = CATIA.ActiveDocument.Selection
Dim oProduct As AnyObject
On Error Resume Next
Set oProduct = oSelection.FindObject("CATIAProduct")
If (Err.Number <> 0) Then
MsgBox "No selected product"
Else
On Error GoTo 0
Dim oInertia As AnyObject
Set oInertia = oProduct.GetTechnologicalObject("Inertia")
Dim dMass As Double
dMass = oInertia.Mass
Dim dDen As Double
dDen = oInertia.Density
MsgBox oProduct.Name & ": Masse = " & CStr(dMass) & " KG" & ": Dichte = " & (CStr(dDen) / 1000) & " "
MyXL.Application.Cells(1, 1).Value = "Masse"
MyXL.Application.Cells(2, 1).Value = dMass
MyXL.Application.Cells(1, 2).Value = "Dichte"
MyXL.Application.Cells(2, 2).Value = "dDen"
MsgBox "Werte wurden in Excel eingetragen"
End If
End Sub
It appears you did not set Option Explicit - put it on the first line and it will help you avoid errors. (With it, the compiler will force you to declare all your variables. This will also mean that when you put it in, your code will not work unless you declare all variables.)
The first problem:
Set xlApp = CreateObject("Excel.Application")
Set MyXL = GetObject(, "Excel.Application")
You first create a new instance of Excel with CreateObject and store a reference to it in xlApp (which you subsequently do not use). Then you try to get a reference to an existing Excel instance with GetObject and store its reference in MyXL. This only works reliably because you first create a new instance. Otherwise you could not guarantee that there always is an Excel instance available.
A related problem is, that you don't release/close these instances. If you create an Excel instance, you need to close it with xlApp.Quit after you're done using it, otherwise it will linger around.
Be careful though with instances you took over with GetObject - calling MyXL.Quit will close the instance regardless of what other workbooks are open at that time.
Similarly, if you open a file this way, you need to make sure to close it afterwards. Otherwise you'll run into the problem you experience: Write protected files.
So, to mend your problem: Close all open instances of Excel (best done via Task Manager, as some of them might be invisible). Then adjust your code to only use one reference to an Excel.Application. And finally make sure to .Close the workbook after you've saved it and .Quit your Excel instance. This should hopefully prevent the error from reappearing.
'Dim xlApp As Excel.Application ' early-bound declaration
'Set xlApp = New Excel.Application ' early-bound assignment
Dim xlApp As Object ' late-bound declaration
Set xlApp = CreateObject("Excel.Application") ' late-bound assignment
'Dim wb As Workbook ' early-bound declaration
Dim wb as Object
Set wb = xlApp.Workbooks.Open(FPath)
' stuff you want to do with the workbook
wb.Close SaveChanges:=True
xlApp.Quit
If you can add a reference to the Excel object model in you Catia VBA project (not sure about that), you can comment out the late-bound lines and use the early-bound lines instead. That way you gain the very useful IntelliSense for the Excel objects. Which makes it so much easier to code.
Thank you guys! I've solved the Problem with simply adding the code:
Workbook.Close SaveChanges:=True
Related
I want to generate and format an excel workbook out of access. The creation of the file is done easy, but I struggle with the format.
file creation
Dim strCurrentDBName As String
strCurrentDBName = CurrentDb.Name
For i = Len(strCurrentDBName) To 1 Step -1
If Mid(strCurrentDBName, i, 1) = "\" Then
strPath = Left(strCurrentDBName, i)
Exit For
End If
Next
xlsxPath = strPath & "Report.xlsx"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Report", xlsxPath, True
MsgBox ("Report generated. " & xlsxPath)
format
Dim xl As Object
'This deals with Excel already being open or not
On Error Resume Next
Set xl = GetObject(, "Excel.Application")
On Error GoTo 0
If xl Is Nothing Then
Set xl = CreateObject("Excel.Application")
End If
Set XlBook = GetObject(xlsxPath)
'filename is the string with the link to the file ("C:/....blahblah.xls")
'Make sure excel is visible on the screen
xl.Visible = True
XlBook.Windows(1).Visible = True
'xl.ActiveWindow.Zoom = 75
'Define the sheet in the Workbook as XlSheet
Set xlsheet1 = XlBook.Worksheets(1)
'Format
With xlsheet1
xlsheet1.Rows("1:1").Select
and here is my error (Run-time error '1004': Application-defined or object-defined error)
xlsheet1.Range(xl.Selection, xl.Selection.End(xlDown)).Select
xlsheet1.Selection.EntireRow.AutoFit
End With
You're using the xlDown enum value, which requires a reference to the Microsoft Excel Object Library. Since you're using late bindings, that reference probably isn't set.
Work around it by using the value of xlDown, -4121:
xlsheet1.Range(xl.Selection, xl.Selection.End(-4121)).Select
Note that this error would've been more easy to spot if you had put Option Explicit at the top of your module.
Prelude
I am starting a new project, and basically I am using Excel as a log for another program I am using. With this being said, this is a mixture of VBA (Only when using Excel's object) and VB6 (the main "host" programming language). This is why both languages are tagged as I anticipate hateful comments from the use of tags; I am looking for a solution in either/mixture of both programming languages!!
Also, I am aware some VBA activists will say to never use ActiveSheet. I am not concerned about this and I would like to say thank you ahead of time. I have one sheet in this workbook as it's primary function is to serve as a log. The ActiveSheet will always be the one and only sheet.
I have the following code, and I am not too familiar with Setting a workbook as an object, which is likely the reason I receive the Bad Index error.
Sub Test()
' Checking if Excel is open, if not, open it.
Dim xL As Object, wBook As Object, iCloseThings As Byte
On Error Resume Next
Set xL = GetObject(, "Excel.Application")
On Error GoTo 0
If xL Is Nothing Then
iCloseThings = 1 ' Set Excel to close only if it was never open
Set xL = CreateObject("Excel.Application")
End If
Set wBook = xL.Workbooks("C:\Users\<UserName>\Documents\<WorkBook>.xlsx").ActiveSheet
If iCloseThings = 1 Then xL.Quit
End sub
What I need assistance with is how would I properly set this object to point to the exact workbook I have in the above example? All I have ever known to do was something such as Set wBook = XL.Workbooks("<WorkBook>.xlsx").ActiveSheet because I knew such workbook would already be open. But with the possibility of it not being open, I need something a little more flexible.
Thanks for your assistance!
you need some different cases handling, mainly depending if the wanted workbook is already open or not should a running Excel session be "caught"
you may want to use some dedicated Functions not to clutter your main code and be more effective in both debugging and maintaining your code, like follows
Option Explicit
Sub Test()
' Checking if Excel is open, if not, open it.
Dim xL As Object, wBook As Object, wSheet As Object, iCloseThings As Byte
Set xL = GetExcel(iCloseThings)
Set wBook = GetExcelWorkbook(xL, "C:\Users\<UserName>\Documents\<WorkBook>.xlsx")
If wBook Is Nothing Then Exit Sub
Set wSheet = wBook.ActiveSheet
If iCloseThings = 1 Then xL.Quit
End Sub
Function GetExcel(iCloseThings As Byte) As Object
On Error Resume Next
Set GetExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If GetExcel Is Nothing Then
iCloseThings = 1 ' Set Excel to close only if it was never open
Set GetExcel = CreateObject("Excel.Application")
End If
End Function
Function GetExcelWorkbook(xL As Object, wbFullName As String) As Object
Dim wbName As String
wbName = Right(wbFullName, Len(wbFullName) - InStrRev(wbFullName, "\"))
On Error Resume Next
Set GetExcelWorkbook = xL.Workbooks(wbName)
On Error GoTo 0
If GetExcelWorkbook Is Nothing Then
Set GetExcelWorkbook = xL.Workbooks.Open(wbFullName)
Else
If GetExcelWorkbook.Path & "\" & wbName <> wbFullName Then
MsgBox "A workbook with the wanted name '" & wbName & "' is already open but its path doesn't match the required one" _
& vbCrLf & vbCrLf & "Close the already open workbook and run this macro again", vbCritical + vbInformation
Set GetExcelWorkbook = Nothing
Else
MsgBox "Wanted workbook is already open", vbInformation
End If
End If
End Function
I have some code for exporting subform results to Excel workbook. Code works fine, only one small issue. If I do export, excel file opens If user wants I open. When this Excel file is opened and user wants to do Export again, I receive error 1004.
This error is produced because file is open, and new Excel object want to save a file with same name. What I want is when this happens, just cancel everything and let user know that he must first close this previously created workbook. Here is what I tried:
If Err.Number = 1004 Then
MsgBox "Error. You have opened Excel file, that has same name as this file name should be. Please close that file first !", vbCritical
Cancel = True
Set wb = Nothing ' wb is wb=XcelFile.Workbooks.Add
Set XcelFile = Nothing ' Xcelfile is Xcelfile= New Excel.Application
End If
This code works, when user closes that file, export can be performed - old file is just overwritted. Problem is that Excel application is still opened in Windows Task Manager, so Excel object is not properly closed.
Does anybody have a better solution ?
P.S.: I tried including numbers in file name of Excel, so that It wouldn't be same name, but I can't get It fixed.
EDIT: Here is how I tried changing filename
Dim i as Integer
ExcelFilename = "RESULTS_" & Format(Date, "dd/mm/yyyy") & "_" & i & "_" & ".xlsx"
i = i + 1
"i" doesn't change It's value when I run code once again. How can I make it increment ? This would solve my problem...
I suggest a simple solution: add the time to the file name to prevent conflicts.
ExcelFilename = "RESULTS_" & Format(Now(), "yyyy-mm-dd_hh-nn-ss") & ".xlsx"
For a number that will increment as long as the application is running, try
Static i As Integer
Static variables
You must be very strict in opening the Excel objects and closing them in reverse order - as done in this example:
Public Sub RenameWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\workbook1.xlsx")
Set wks = wkb.Worksheets(1)
wks.Name = "My New Name"
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub
Good Morning All,
I have fought with this for a few days now, and have not yet found a suitable solution, so I hope somebody can put me out of my misery!
From within an excel document, I have 3 buttons to check out and open 3 documents from a Microsoft Sharepoint Server. 2 files are Excel workbooks, and one is a Word document.
The excel files work absolutely fine, but the Word document always returns 'False' when the .CanCheckOut statement is reached, even though I can manually check it out on MOSS, have the correct permissions etc. I have added the Microsoft Word 11.0 Object Library reference in my Excel VBA.
Here is my code for the excel ones:
Sub CheckOutXL(FullPath As String)
Dim xlApp As Object
Dim wb As Workbook
Dim xlFile As String
xlFile = FullPath
Set xlApp = CreateObject("Excel.Application")
'Determine if workbook can be checked out.
If Workbooks.CanCheckOut(xlFile) = True Then
'Check out file
Workbooks.CheckOut xlFile
'Open File
Set xlApp = New Excel.Application
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(xlFile, , False)
'Otherwise offer the option to open read-only
Else
If (MsgBox("You are unable to check out this document at this time, would you like to open it read-only?", vbYesNo) = vbYes) Then
Set xlApp = New Excel.Application
xlApp.Visible = True
Set wb = xlApp.Workbooks.Open(xlFile, , False)
End If
End If
and for the Word one:
Sub CheckOutDoc(FullPath As String)
If Documents(docFile).CanCheckOut = True Then 'This is the one that returns FALSE
Documents.CheckOut docFile
' Set objWord = CreateObject("Word.Application") 'The commented out section was
' objWord.Visible = True 'a second way I tried to open
' objWord.Documents.Open docFile 'the file.
Documents.Open Filename:=docFile
Else
If (MsgBox("You are unable to check out this document at this time, would you like to open it read-only?", vbYesNo) = vbYes) Then
Documents.Open Filename:=docFile
End If
End If
End Sub
These are both called using a simple line for each button as such:
Private Sub btnTrend_Click()
Call CheckOutXL("FullPathOfTheFileInHere.xls")
End Sub
Any help massively appreciated!! Thanks
We are having the same issue. Can you try this:
If CBool(Documents(docFile).CanCheckOut) = True Then
I'm trying to run an Excel macro from outside of the Excel file. I'm currently using a ".vbs" file run from the command line, but it keeps telling me the macro can't be found. Here is the script I'm trying to use
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("test.xls")
objExcel.Application.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(1, 1).Value = "Test value"
objExcel.Application.Run "Macro.TestMacro()"
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
WScript.Echo "Finished."
WScript.Quit
And here is the Macro I'm trying to access:
Sub TestMacro()
'first set a string which contains the path to the file you want to create.
'this example creates one and stores it in the root directory
MyFile = "C:\Users\username\Desktop\" & "TestResult.txt"
'set and open file for output
fnum = FreeFile()
Open MyFile For Output As fnum
'write project info and then a blank line. Note the comma is required
Write #fnum, "I wrote this"
Write #fnum,
'use Print when you want the string without quotation marks
Print #fnum, "I printed this"
Close #fnum
End Sub
I tried the solutions located at Is it possible to run a macro in Excel from external command? to get this far (and modified of course) but it didn't seem to work. I keep getting the error `Microsoft Office Excel: The macro 'Macro.TestMacro' cannot be found.
EDIT: Excel 2003.
Ok, it's actually simple. Assuming that your macro is in a module,not in one of the sheets, you use:
objExcel.Application.Run "test.xls!dog"
'notice the format of 'workbook name'!macro
For a filename with spaces, encase the filename with quotes.
If you've placed the macro under a sheet, say sheet1, just assume sheet1 owns the function, which it does.
objExcel.Application.Run "'test 2.xls'!sheet1.dog"
Notice: You don't need the macro.testfunction notation you've been using.
This code will open the file Test.xls and run the macro TestMacro which will in turn write to the text file TestResult.txt
Option Explicit
Dim xlApp, xlBook
Set xlApp = CreateObject("Excel.Application")
'~~> Change Path here
Set xlBook = xlApp.Workbooks.Open("C:\Test.xls", 0, True)
xlApp.Run "TestMacro"
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
WScript.Echo "Finished."
WScript.Quit
Since my related question was removed by a righteous hand after I had killed the whole day searching how to beat the "macro not found or disabled" error, posting here the only syntax that worked for me (application.run didn't, no matter what I tried)
Set objExcel = CreateObject("Excel.Application")
' Didn't run this way from the Modules
'objExcel.Application.Run "c:\app\Book1.xlsm!Sub1"
' Didn't run this way either from the Sheet
'objExcel.Application.Run "c:\app\Book1.xlsm!Sheet1.Sub1"
' Nor did it run from a named Sheet
'objExcel.Application.Run "c:\app\Book1.xlsm!Named_Sheet.Sub1"
' Only ran like this (from the Module1)
Set objWorkbook = objExcel.Workbooks.Open("c:\app\Book1.xlsm")
objExcel.Run "Sub1"
Excel 2010, Win 7
I tried to adapt #Siddhart's code to a relative path to run my open_form macro, but it didn't seem to work. Here was my first attempt. My working solution is below.
Option Explicit
Dim xlApp, xlBook
dim fso
dim curDir
set fso = CreateObject("Scripting.FileSystemObject")
curDir = fso.GetAbsolutePathName(".")
set fso = nothing
Set xlApp = CreateObject("Excel.Application")
'~~> Change Path here
Set xlBook = xlApp.Workbooks.Open(curDir & "Excels\CLIENTES.xlsb", 0, true)
xlApp.Run "open_form"
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
WScript.Echo "Finished."
EDIT
I have actually worked it out, just in case someone wants to run a userform "alike" a stand alone application:
Issues I was facing:
1 - I did not want to use the Workbook_Open Event as the excel is locked in read only.
2 - The batch command is limited that the fact that (to my knowledge) it cannot call the macro.
I first wrote a macro to launch my userform while hiding the application:
Sub open_form()
Application.Visible = False
frmAddClient.Show vbModeless
End Sub
I then created a vbs to launch this macro (doing it with a relative path has been tricky):
dim fso
dim curDir
dim WinScriptHost
set fso = CreateObject("Scripting.FileSystemObject")
curDir = fso.GetAbsolutePathName(".")
set fso = nothing
Set xlObj = CreateObject("Excel.application")
xlObj.Workbooks.Open curDir & "\Excels\CLIENTES.xlsb"
xlObj.Run "open_form"
And I finally did a batch file to execute the VBS...
#echo off
pushd %~dp0
cscript Add_Client.vbs
Note that I have also included the "Set back to visible" in my Userform_QueryClose:
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ThisWorkbook.Close SaveChanges:=True
Application.Visible = True
Application.Quit
End Sub
Anyway, thanks for your help, and I hope this will help if someone needs it
I tried the above methods but I got the "macro cannot be found" error.
This is final code that worked!
Option Explicit
Dim xlApp, xlBook
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
' Import Add-Ins
xlApp.Workbooks.Open "C:\<pathOfXlaFile>\MyMacro.xla"
xlApp.AddIns("MyMacro").Installed = True
'
Open Excel workbook
Set xlBook = xlApp.Workbooks.Open("<pathOfXlsFile>\MyExcel.xls", 0, True)
' Run Macro
xlApp.Run "Sheet1.MyMacro"
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
WScript.Quit
In my case, MyMacro happens to be under Sheet1, thus Sheet1.MyMacro.
I generally store my macros in xlam add-ins separately from my workbooks so I wanted to open a workbook and then run a macro stored separately.
Since this required a VBS Script, I wanted to make it "portable" so I could use it by passing arguments. Here is the final script, which takes 3 arguments.
Full Path to Workbook
Macro Name
[OPTIONAL] Path to separate workbook with Macro
I tested it like so:
"C:\Temp\runmacro.vbs" "C:\Temp\Book1.xlam" "Hello"
"C:\Temp\runmacro.vbs" "C:\Temp\Book1.xlsx" "Hello" "%AppData%\Microsoft\Excel\XLSTART\Book1.xlam"
runmacro.vbs:
Set args = Wscript.Arguments
ws = WScript.Arguments.Item(0)
macro = WScript.Arguments.Item(1)
If wscript.arguments.count > 2 Then
macrowb= WScript.Arguments.Item(2)
End If
LaunchMacro
Sub LaunchMacro()
Dim xl
Dim xlBook
Set xl = CreateObject("Excel.application")
Set xlBook = xl.Workbooks.Open(ws, 0, True)
If wscript.arguments.count > 2 Then
Set macrowb= xl.Workbooks.Open(macrowb, 0, True)
End If
'xl.Application.Visible = True ' Show Excel Window
xl.Application.run macro
'xl.DisplayAlerts = False ' suppress prompts and alert messages while a macro is running
'xlBook.saved = True ' suppresses the Save Changes prompt when you close a workbook
'xl.activewindow.close
xl.Quit
End Sub
If you are trying to run the macro from your personal workbook it might not work as opening an Excel file with a VBScript doesnt automatically open your PERSONAL.XLSB. you will need to do something like this:
Dim oFSO
Dim oShell, oExcel, oFile, oSheet
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
Set oExcel = CreateObject("Excel.Application")
Set wb2 = oExcel.Workbooks.Open("C:\..\PERSONAL.XLSB") 'Specify foldername here
oExcel.DisplayAlerts = False
For Each oFile In oFSO.GetFolder("C:\Location\").Files
If LCase(oFSO.GetExtensionName(oFile)) = "xlsx" Then
With oExcel.Workbooks.Open(oFile, 0, True, , , , True, , , , False, , False)
oExcel.Run wb2.Name & "!modForm"
For Each oSheet In .Worksheets
oSheet.SaveAs "C:\test\" & oFile.Name & "." & oSheet.Name & ".txt", 6
Next
.Close False, , False
End With
End If
Next
oExcel.Quit
oShell.Popup "Conversion complete", 10
So at the beginning of the loop it is opening personals.xlsb and running the macro from there for all the other workbooks. Just thought I should post in here just in case someone runs across this like I did but cant figure out why the macro is still not running.
Hi used this thread to get the solution , then i would like to share what i did just in case someone could use it.
What i wanted was to call a macro that change some cells and erase some rows, but i needed for more than 1500 excels( approximately spent 3 minuts for each file)
Mainly problem:
-when calling the macro from vbe , i got the same problem, it was imposible to call the macro from PERSONAL.XLSB, when the script oppened the excel didnt execute personal.xlsb and wasnt any option in the macro window
I solved this by keeping open one excel file with the macro loaded(a.xlsm)(before executing the script)
Then i call the macro from the excel oppened by the script
Option Explicit
Dim xl
Dim counter
counter =10
Do
counter = counter + 1
Set xl = GetObject(, "Excel.Application")
xl.Application.Workbooks.open "C:\pruebas\macroxavi\IA_030-08-026" & counter & ".xlsx"
xl.Application.Visible = True
xl.Application.run "'a.xlsm'!eraserow"
Set xl = Nothing
Loop Until counter = 517
WScript.Echo "Finished."
WScript.Quit