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
Related
I have appended a code I tested to copy and paste some data to Excel. i want to do 1) Check if directory exists 2) if it doesn't create it 3) if it does, display message box and stop the sub
Dim excelapp As Excel.Application
Dim wbTarget As Excel.Workbook
Dim qdfquerytest As QueryDef
Dim rsquerytest As Recordset
Set qdfquerytest = CurrentDb.QueryDefs("OpenComplaintsQuery") 'which query to define
Set rsquerytest = qdfquerytest.OpenRecordset() 'which recordset to open
Set excelapp = CreateObject("Excel.Application") 'create an Excel instance
excelapp.Visible = True 'Make Excel visible
If Len(Dir("O:\1_All Customers\Current Complaints\Complaint Folders\" &
rsquerytest(1).Value)) = 0 Then
MkDir "O:\1_All Customers\Current Complaints\Complaint Folders\ &
rsquerytest(1).Value"
Else
MsgBox "Folder already exists!", vbOKOnly
Exit Sub
End If
When i run i get runtime 75 error about file path isn't valid. I am pretty sure if the way i have the directory typed out to include rsquerytest(1) which is a serial number in the record. Additionally despite the error the code continues to run should i have put the If statement BEFORE setting Excel app?
Editting Post to post Code that is working
Private Sub cmdcopyfieldsonly_Click()
'This function works
'Things to add Checking for directory usage, Create the
directory, Stopping if directory is found and msg box,
'Declare and set excel objects and target data
Dim excelapp As Excel.Application
Dim wbTarget As Excel.Workbook
Dim qimsnum As Variant
Dim rsquerytest As Recordset
Set rsquerytest =
CurrentDb().OpenRecordset("OpenComplaintsQuery") 'which
recordset to open
Set qimsnum = Me.[QIMS#]
Dim savepath As String
Dim openpath As String
savepath = "Redacted filepath"
openpath = "Redacted Filepath"
'Set excelapp = CreateObject("Excel.Application") 'create an
Excel instance
'excelapp.Visible = True 'Make Excel visible
If Len(Dir(savepath & Me.[QIMS#], vbDirectory)) = 0 Then
MkDir savepath & Me.[QIMS#]
Else
MsgBox "Folder already exists!", vbOKOnly
Exit Sub
End If
I did leave portions after the If out as it does not pertain to this issue, June7 should have listened to you the first time i believe in a previous post you helped me with, I couldn't wrap my brain around it. and i am well aware this code can be cleaned up further ;), i am just working out the basic functions and will clean it up from there. Thank you for you support!
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
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.
I understand similar questions with these errors have been posted before, but I found nothing when it came to formatting tables so don't close this please. In my VBA code in MS Access 2013 it exports data from MS Access to Excel. 6 different queries get exported into 1 excel file, each on a different worksheet. This works fine. I then format each sheet to have all the data in a table. I have a form which lets the user choose the path to save the file. If it is the first time creating the file, it works properly. If it is the second time creating the file in that same directory, it doesn't work and it gives me the error:
Run-time error 1004: Method Range of object _Global failed
I figured this was because I was overwriting my file instead of deleting it and recreating it. So I added in some code to check if the file exists, and if it does, delete it. I added breakpoints and while running through this part of the code, I was watching my documents folder. The file successfully got deleted and then recreated which is what I wanted. It still gave me that error. I manually went to delete the file and then reran my code again. It worked properly.
How come I need to manually delete this file in order to rerun my code? Or is it something else that is causing the problem? Here is the important parts of my code as the whole thing is too long to post:
'Checks if a file exists, then checks if it is open
Private Sub checkFile(path As String)
Dim openCheck As Boolean
'If file exists, make sure it isn't open. If it doesn't, create it
If Dir(path) <> "" Then
openCheck = IsFileLocked(path)
If openCheck = True Then
MsgBox "Please close the file in " & path & " first and try again."
End
Else
deleteFile (path)
End If
Else
End If
End Sub
Sub deleteFile(ByVal FileToDelete As String)
SetAttr FileToDelete, vbNormal
Kill FileToDelete
End Sub
Private Sub dumpButton_Click()
On Error GoTo PROC_ERR
Dim path As String
Dim testBool As Boolean
path = pathLabel4.Caption
path = path & Format(Date, "yyyy-mm-dd") & ".xlsx"
checkFile (path)
dumpQueries (path)
formatFile (path)
'Error Handling
PROC_ERR:
If Err.Number = 2001 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 2501 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 3021 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 2302 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 0 Then
MsgBox "Your file has been stored in " & pathLabel4.Caption
Exit Sub
Else
MsgBox Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & "New Error. Please contact the IT department."
End If
Private Sub dumpQueries(path As String)
Dim obj As AccessObject, dB As Object
Set dB = Application.CurrentData
For Each obj In dB.AllQueries
testBool = InStr(obj.name, "Sys")
If testBool <> True Then
If obj.name = "example1" Or obj.name = "example2" Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, obj.name, path, True, editWorksheetName(obj.name)
End If
End If
Next obj
End Sub
'Autofits the cells in every worksheet
Private Sub formatFile(path As String)
Dim Date1 As Date, strReportAddress As String
Dim objActiveWkb As Object, appExcel As Object
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = False
appExcel.Application.Workbooks.Open (path)
Set objActiveWkb = appExcel.Application.ActiveWorkbook
With objActiveWkb
Dim i As Integer
For i = 1 To .Worksheets.count
.Worksheets(i).Select
.Worksheets(i).Cells.EntireColumn.AutoFit
.Worksheets(i).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).name = "myTable1"
Next
End With
appExcel.ActiveWindow.TabRatio = 0.7
objActiveWkb.Close savechanges:=True
appExcel.Application.Quit
Set objActiveWkb = Nothing: Set appExcel = Nothing
End Sub
The error occurs near the bottom of the code. It's the line:
.Worksheets(i).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).name = "myTable1"
There may be a couple functions I left out but they work fine and shouldn't be needed for answering the question.
This is the only relevant code:
Set objActiveWkb = appExcel.Application.ActiveWorkbook
With objActiveWkb
Dim i As Integer
For i = 1 To .Worksheets.count
.Worksheets(i).Select
.Worksheets(i).Cells.EntireColumn.AutoFit
.Worksheets(i).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).name = "myTable1"
Next
End With
Things get easier to follow when you trim the fluff away and start naming things - there's no need to .Select anything, appExcel is already an Application object, and there's no need to make a copy reference to the active workbook just to use in a With block, especially if that copy is going to be an Object variable anyway - if the copy were a Workbook object then you would at least get IntelliSense for its members...
Your source range is ambiguous. Range("A1") in Excel-VBA is an implicit reference to the active worksheet.. but this is Access-VBA, so there's no such thing, xlSrcRange is an enum value defined in the Excel object model, so if you don't have a reference to the Excel object model (you're late-binding this, right?), and Option Explicit isn't specified, then xlSrcRange is treated by VBA like just another undeclared/uninitialized variable, and therefore you're passing a 0 there, and the xlSrcRange enum value stands for a 1 - and 0 happens to be the underlying value for xlSrcExternal. Same with xlYes.
Since we cannot possibly guess what the actual source range is supposed to be from the code you posted, I'm leaving you with this:
Dim target As Object
Dim srcRange As Object
Set srcRange = TODO
With appExcel.ActiveWorkbook
Dim i As Integer
For i = 1 To .Worksheets.Count
.Worksheets(i).Cells.EntireColumn.AutoFit
Set target = .Worksheets(i).ListObjects.Add(1, srcRange, , 1)
If target Is Not Nothing Then target.Name = "myTable1"
Next
End With
Side question... why name the table myTable1 when Excel will already have named it Table1 anyway? Also note, if .Add fails, your code blows up with a runtime error 91 because you'd be calling .Add off Nothing. Verifying that the target is not Nothing before setting its Name will avoid that.
To answer your question in the comments:
#Mat'sMug is this what you were talking about? because it gives me this error: "438: Object doesn't support this property or method" Here's the code: .Worksheets(i).ListObjects.Add(SourceType:=xlSrcRange, Source:=.Cells(1).CurrentRegion, _ XlListObjectHasHeaders:=xlYes, TableStylename:="TableStyleMedium1").name = "Table"
The reason this throws a 438 is because your With block variable is a Workbook object, and a Workbook object doesn't have a .Range member.
What I was talking about, is that in Excel VBA unqualified calls to Range, Row, Column, and Cells are implicitly referencing the ActiveSheet, and unqualified calls to Worksheets, Sheets and Names are implicitly referencing the ActiveWorkbook - that's a recurrent problem in a lot of VBA code and a very common mistake to make. The solution is basically to say what you mean, and mean what you say; in this case the failure is on "mean what you say" - the unqualified Range("A1") call is, according to the error message, calling [_Globals].Range("A1")... which is weird because it implies that you're referencing the Excel object model library, which means your late-binding and Object variables could just as well be early-bound: why deal with Object variables and lack of IntelliSense when you're already referencing the library you're late-binding to?
Dim objXL, strMessage
On Error Resume Next
Set objXl = GetObject(, "Excel.Application")
If Not TypeName(objXL) = "Empty" then
strMessage = "Excel Running"
Else
strMessage = "Excel NOT Running"
End If
MsgBox strMessage, vbInformation, "Excel Status"
Hey thanks alot buddy. This really brings me close to what am looking for, moving much closer to the solution.
Let me tell you my exact requirement/issue:
Actually my issue is that, from Java I am trying to find Excel instance with a particular workbook name but am not returned an Excel instance even though it appears. In my case I have an Excel opened with 2 workbooks "Book1" and "Book2" in it.
When am trying to find Excel with any of these workbook name, am given no result. To narrow down, this issue is observed only on one of my client machines. On rest machines this same java code working fine.
This started happening after uninstalling Excel2010 and installing Excel2007.
So what I am trying to do is that, want to create one vbscript where I can give the workbookname as an input and it will return me whether there is such Excel instance running with given workbook name.
Hey please guide me further towards creating such script where I will give the workbook name and script will find whether such Excel instance is running or not. Not an issue even if workbook name is passed as an hardcoded input in script. I will alter as per my workbook name.
Thanks for your previous reply and awaiting for this one too.. :))
If you potentially have more than one excel instance open than to detect if a specific workbook is open you could use:
This code to examine all open workbooks in all instances Can VBA Reach Across Instances of Excel?
Detect if the file is already in use. See Sid's suggestion from Detect whether Excel workbook is already open
Doug's suggestion to use GetObject to attach to a host instance where you know the workbook name. As per the Microsoft Support article you can use Set xlApp = GetObject("YourExcelName").Application to detect if "YourExcelName" is open in any instance
In the question that you initially asked, the code below uses GetObject to detect whether any instance is open, and if there is an ActiveWorkbook and what that name ie. From your edited question my three links above are more relevant than this code.
Dim objXL, WB, strMessage
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
Set WB = objXL.ActiveWorkbook
On Error GoTo 0
If Not TypeName(objXL) = "Empty" Then
If Not TypeName(WB) = "Nothing" Then
strMessage = "Excel Running - " & objXL.ActiveWorkbook.Name & " is active"
Else
strMessage = "Excel Running - no workbooks open"
End If
Else
strMessage = "Excel NOT Running"
End If
MsgBox strMessage, vbInformation, "Excel Status"""
I not use Excel, and I hope that the next code may give you a starting point.
But if you have many Excel instances running then should investigate future more yourself.
Dim objXL, strName, bFound, strMsg
On Error Resume Next
Set objXl = GetObject(, "Excel.Application")
On Error GoTo 0
If Err Then
MsgBox "Excel NOT Running", vbInformation, "Excel Status"
WScript.Quit(-1)
End If
strName = InputBox("Enter Workbook Name:", "Required")
If Len(strWBName) = 0 Then WScript.Quit(-2)
bFound = False
If objXL.Workbooks.Count > 0 Then
For Each wb In objXL.Workbooks
If wb.Name = strName Then
bFound = True
Exit For
End If
Next
End If
strMsg = "Workbook " & UCase(strName) & " is "
If bFound Then
MsgBox strMsg & "open", vbInformation, "Result"
Else
MsgBox strMsg & "not open", vbInformation, "Result"
End If
P.S. After reading Brettdj updated answer looks like GetObject can help for multiple Excel instances, so if that works you can capsule your test in a function.
Function IsWBookOpen(strWBook)
On Error Resume Next
Dim wb: Set wb = GetObject(strWBook)
IsWBookOpen = Not Err
End Function
You can capture the active workbook name with the following command. objXL.ActiveWorkbook.Name
Dim objXL, strMessage
On Error Resume Next
Set objXL = GetObject(,"Excel.Application")
If Not TypeName(objXL) = "Empty" then
strMessage = "Excel Running"
WScript.Echo "The active workbook name is " & objXL.ActiveWorkbook.Name
Else
strMessage = "Excel NOT Running"
End If
MsgBox strMessage, vbInformation, "Excel Status"