I made a wizard button on a Access form where you can transfer the data of a Query to a new excel file and then the new file will automatically open.
Is there a way to make a reference to this new file or Sheet, because i want to put something in this new file.
This will get an open instance of Excel if it exists or create one if there isn't one.
Public Function GetExcelApp() As Excel.Application
' Returns open excel instance.
' If it doesn't exist, creates one to return
On Error GoTo ErrHandler
Const PROC_NAME As String = "GetExcelApp"
Const ERR_APP_NOTRUNNING As Long = 429
Set GetExcelApp = GetObject(, "Excel.Application")
CleanExit:
Exit Function
ErrHandler:
If Err.Number = ERR_APP_NOTRUNNING Then
Set GetExcelApp = CreateObject("Excel.Application")
Else
Err.Raise Err.Number, GetErrorSource(PROC_NAME), Err.Description & vbNewLine & "Unable to get instance of Excel.", Err.HelpFile, Err.HelpContext
End If
End Function
I keep this code in an XLHelper class and use it like this.
Dim helper As New XLHelper
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set xl = helper.GetExcelApp
Set wb = xl.Workbooks.Add
Set ws = wb.Worksheets.Add
To get the reference of the new sheet/workbook, you just set it equal to the results of the collection's Add method.
This works because Workbook.Add and Worksheets.Add return the object they create.
Related
I've set up code that opens a word document and closes excel, from the word document there is code to reopen excel and copy user data to a new sheet which I pull from for a form. This whole process works perfectly, the issue is trying to close the word document once I've finished my tasks.
I want to close the word document once I'm back in excel however everything I'm trying returns bad file name error when I try to reference the doc. I know for a fact that the file path is correct. I also know that you cant reference the open doc the normal way you would. I've substituted the variable filePath for privacy reasons.
Here is the code from word which is executed first
Sub sendTableToExcel()
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim ws As Worksheet
Dim doc As Document
Dim tbl As Table
Set doc = ThisDocument
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWb = xlApp.Workbooks.Open(filePath)
Set ws = Sheets.Add
ws.Name = "temp"
Set tbl = doc.Tables(1)
tbl.Range.Copy
xlWb.Worksheets(ws.Name).PasteSpecial wdPasteText
ws.Visible = False
xlWb.Application.Run "pasteCopiedValuesFromRequestDocs"
xlWb.Application.Run "openRequestLanding", "Casual" //this is the where I'm trying to close the doc
Set xlWb = Nothing
Set xlApp = Nothing
Set tblRange = Nothing
Set tbl = Nothing
Set doc = Nothing
End Sub
and the sub from excel which is called from word
Public Sub openRequestLanding(requestType As String)
Dim wdApp As Word.Application
Dim doc As Word.Document
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set doc = wdApp.Documents(filePath)
doc.Close SaveChanges:=wdDoNotSaveChanges
Set wdApp = Nothing
Set doc = Nothing
RequestLanding.RequestTypeBox.Value = requestType
RequestLanding.Show
End Sub
You will have no success in closing the document as it is not open in the instance of Word that your code references. Your code in Excel needs to get the currently open instance of Word, not create a new one.
Change
Set wdApp = CreateObject("Word.Application")
to
Set wdApp = GetObject(, "Word.Application")
I have the following routine below that is meant to open an Excel spreadsheet and then go row by row to import the results into a table that is passed in. It works fine but the problem is if I try to open that same spreadsheet a second time I get a message that the file is in use and I have to Ctrl-Alt-Del to shut down Excel before I can use it again. I thought that the Set mySheet=Nothing and Set xlApp=Nothing would release the file but apparently not. What more can I do to make sure that Access lets go of the Excel file? Thanks in advance!
Public Sub MakeTempTable(strFilePath As String, tablename As String)
Dim mySheet As Object
Dim xlApp As Object
Dim rs As DAO.Recordset
Dim sql As String
sql = "DELETE * FROM " & tablename
DoCmd.RunSQL sql
Set rs = CurrentDb.OpenRecordset(tablename)
Set xlApp = CreateObject("Excel.Application")
Set mySheet = xlApp.Workbooks.Open(strFilePath).Sheets(1)
xlApp.Visible = False
Set mySheet = xlApp.Sheets("Input")
Dim dRows As Double
dRows = 1
Dim dRow As Double, dCol As Double
dRow = 2
On Error GoTo ERR
Do
dCol = 1
rs.AddNew
If mySheet.cells(dRow, 3) = "" Then Exit Do
Do
If mySheet.cells(dRow, dCol).Value <> "_END_" Then
rs.Fields(dCol).Value = Nz(mySheet.cells(dRow, dCol).Value, "")
dCol = dCol + 1
Else
Exit Do
End If
Loop
rs.Update
dRow = dRow + 1
Loop
EXITSUB:
Set mySheet = Nothing
Set xlApp = Nothing
Exit Sub
ERR:
If ERR.Number = 3265 Then MsgBox "The species selected are incompatible. Canceling import.", vbCritical, "IMPORT ERROR"
GoTo EXITSUB
End Sub
Try using
xlApp.Quit
When you set xlApp to nothing you are only clearing the object within the procedure, you aren't doing anything to the actual Excel instance. All that setting XXX = nothing allows you to do is then reuse that object.
You will need to legally close the workbooks that are open as in
xlApp.Workbooks.Close
EXITSUB:
This will close the instances that are open.
Prior to this, kill all the instances or reboot your machine to clear all the instances that are open.
I am getting inconsistent results when I try to refer to an active workbook. About half the time I get the "Method of 'Sheets' of Object '_Global' not failed" error and other times the code works fine. I don't see a pattern.
The VBA code is part of a Word document that allows the user to open a template Excel file and select/copy text from the Word doc into rows on the Excel file.
In a previous sub I successfully open an Excel template file (I call it a RTM template). In the code below I want to activate the "RTM" worksheet, select the first cell where the template could already have data in it from a previous execution and if there is, then count how many rows of data exist. In this way the new data will be posted in the first row which does not have any data. I am using named ranges in my Workbook to refer to the starting cell ("First_Cell_For_Data").
When I run my code sometimes it runs without error and other times it stops on the "Sheets("RTM").Activate" and gives me the "Method...." error. The same result occurs when I change the variable definition of wb_open to Object. I have also tried using "wb_open.Sheets("RTM").Activate" with the same results.
As suggested in the comments below I added "If wb_open is nothing ...." to debug the issue. I also added the sub List_Open_Workbooks which enumerates the open workbooks (of which there is only 1) and activates the one that matches the name of the one with the correct filename. This is successful. But upon returning to Check_Excel_RTM_Template I still get the Method error on the "Sheets("RTM").Activate" line.
Second Update: after more time diagnosing the problem (which still occurs intermittently) I have added some code that may help getting to the root of the problem. In the "List_Open_Workbooks" sub I test for xlApp.Workbooks.Count = 0. So all references to an open Excel workbook will fail. At this point my template workbook is open in Windows. Am I drawing the correct conclusion?
Third Update: I tried Set wb_open = GetObject(str_filename) where str_filename contains the name of the Excel template file I just opened.
I get the following error message.
Also, I noticed that if I start with a fresh launch of Word and Excel it seems to run just fine.
Sub Check_Excel_RTM_Template(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim i_starting_row_for_data As Integer
Dim wb_open As Object
Set wb_open = ActiveWorkbook
i_rows_of_data = 0
If wb_open Is Nothing Then
MsgBox "RTM Workbook not open in Check_Excel_RTM_Template"
Call List_Open_Workbooks(b_Excel_File_Has_Data, i_rows_of_data)
Else
' On Error GoTo Err1:
' Sheets("RTM").Activate
' range("First_Cell_For_Data").Select
Workbooks(wb_open.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
Exit Sub
Err1:
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
Sub to enumerate all open workbooks
Sub List_Open_Workbooks(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim str_filename As String
Dim xlWB As Excel.Workbook
If xlApp.Workbooks.Count = 0 Then
MsgBox "Error: Windows thinks there are no workbooks open in List_Open_Workbooks"
b_abort = True
Exit Sub
End If
For Each xlWB In xlApp.Workbooks
Debug.Print xlWB.Name
str_filename = getName(str_Excel_Filename)
If Trim(xlWB.Name) = Trim(str_filename) Then
xlWB.Activate
If xlWB Is Nothing Then
MsgBox "Workbook still not active in List_Open_Workbooks"
b_abort = True
Exit Sub
Else
' Sheets("RTM").Activate
Workbooks(xlWB.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
End If
Next xlWB
Set xlApp = Nothing
Set xlWB = Nothing
End Sub
Function to extract filename from path/filename
Function getName(pf)
getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0) & ".xlsx"
End Function
I am hoping I found the source of my problem and solved it.
I believe that referring to an open workbook in sub using Dim wb_open As Object & Set wb_open = ActiveWorkbook in the Check_Excel_RTM_Template sub is causing my inconsistent problems....perhaps this is an anomoly (bug) in the VBA implementation in Word.
In the revised code I posted below I am passing the o_Excel object from the calling routine and using oExcel.Activesheet.xxx to reference ranges and values.
Now I next problem is that I am having errors on the form control button code which also uses the Dim wb_open As Object & Set wb_open = ActiveWorkbook approach to referring to the open workbook. But I'll post that as a new question.
Thanks to all who commented and provided suggestions.
Sub Check_Excel_RTM_Template(oExcel As Object)
Dim i_starting_row_for_data As Integer
Dim str_filename As String
i_rows_of_data = 0
On Error GoTo Err1:
oExcel.ActiveSheet.range("First_Cell_For_Data").Select
If Trim(oExcel.ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(oExcel.ActiveCell.Value) = ""
oExcel.ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
Exit Sub
Err1:
Documents(str_doc_index).Activate
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
I'm writing a macro in Access that (hopefully) will:
create an Excel worksheet
set up and format it based on information in the Access database
after user input, will feed entered data into an existing Excel master file
Opening the blank sheet etc. is working absolutely fine, but I'm stuck trying to set the existing master file up as a variable:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
Dim wbXLname As String
Set appXL = CreateObject("Excel.Application")
appXL.Visible = True
wbXLname = "G:\[*full reference to file*].xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
'separate function (Boolean), using 'attempt to open file and lock it' method
'from Microsoft site.
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
'open file and set as variable.
ElseIf IsWBOpen = True Then
wbXLcore = appXL.Workbooks("ResultsOverall.xlsm") 'ERROR HERE.
'file is already open, so just set as variable.
End If
Debug.Print wbXLcore.Name
Debug.Print IsWBOpen
Set appXL = Nothing
End Sub
When the file is closed, this works perfectly. However, when it's open I get:
Run-Time error '9':
Subscript out of range
I'm only just starting to teach myself VBA (very trial and error!) and nothing else I've seen in answers here / Google quite seems to fit the problem, so I'm a bit lost...
Considering that it works fine when the file is closed, I suspect I've just made some silly error in referring to the file - perhaps something to do with the 'createobject' bit and different excel instances??
Any suggestions would be much appreciated! Thanks
Thank you #StevenWalker
Here's the working code:
Sub XLData_EnterSurvey()
Dim appXL As Excel.Application
Dim wbXLnew As Excel.Workbook, wbXLcore As Excel.Workbook
Dim wsXL As Excel.Worksheet
On Error GoTo Handler
Set appXL = GetObject(, "Excel.Application")
appXL.Visible = True
Dim wbXLname As String
wbXLname = "G:\ [...] .xlsm"
IsWBOpen = fnIsWBOpen(wbXLname)
If IsWBOpen = False Then
Set wbXLcore = appXL.Workbooks.Open(wbXLname, True, False)
ElseIf IsWBOpen = True Then
Set wbXLcore = appXL.Workbooks("ResultsOverall.xlsm")
End If
Set appXL = Nothing
'-------------------Error handling------------------
Exit Sub
' For if excel is not yet open.
Handler:
Set appXL = CreateObject("Excel.Application")
Err.Clear
Resume Next
End Sub
Sorry I'm on my phone so I can't go in to too much detail or do much with the code but at a glance I think you might need to add an error handler so that if the file is already open, a different line of code is executed.
Add 'On error go to handler' (before creating the excel object) and at the bottom
Of your code add 'handler:'. In the error handler, use get object rather than create object.
You will have to ensure you use exit sub before the error handler or it will run the handler every time you run the code.
You can see an example of what I mean here: How to insert chart or graph into body of Outlook mail
Although please note in this example it's the other way round (if error 'getting' outlook, then create it).
Example in link:
Set myOutlook = GetObject(, "Outlook.Application")
Set myMessage = myOutlook.CreateItem(olMailItem)
rest of code here
Exit Sub
'If Outlook is not open, open it
Handler:
Set myOutlook = CreateObject("Outlook.Application")
Err.Clear
Resume Next
End sub
If you move the appXL.Workbooks statement to the debugging window, you will find that the names of the items in that collection are without extension.
So in your case, I'm guessing the line should read:
wbXLcore = appXL.Workbooks("ResultsOverall")
I am importing data from Outlook. The code for opening Excel opens an instance where personal.xlsb is not loaded, and will open multiple instances of Excel. If I run it twice it will open two instances but will overwrite the data in the first instance, leaving the second instance with a blank workbook. If Excel is closed and Outlook is not, then the code is run it will give an error since it won't put the data into the new "second" instance, even though only one instance is running.
Sub Extract()
On Error GoTo 0
Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")
Dim ThermoMail As Outlook.MailItem
Set ThermoMail = Application.ActiveInspector.CurrentItem
Set xlobj = CreateObject("excel.application")
xlobj.Visible = True
xlobj.Workbooks.Add
'Set Headings
Dim msgText, delimtedMessage, Delim1 As String
delimtedMessage = ThermoMail.Body
'Remove everything before "Lead Source:" and after "ELMS"
TrimmedArray = Split(delimtedMessage, "Source:")
delimtedMessage = TrimmedArray(1)
TrimmedArray = Split(delimtedMessage, "ELMS")
delimtedMessage = TrimmedArray(0)
'Split the array at each return
messageArray = Split(delimtedMessage, vbCrLf)
'this next line gives the error if excel is closed and the macro is rerun.
Range("A1:A" & UBound(messageArray) + 1) = WorksheetFunction.Transpose(messageArray)
Call splitAtColons
End Sub
Right now, you are creating a new instance of Excel with this line:
Set xlobj = CreateObject("excel.application")
Excel is different than some (most) Office Applications, because it can run multiple instances (PowerPoint, Outlook, Word cannot do this...)
So what you want to do is first check if there is an open instance of Excel, and use that. Only create a new instance if there is no instance already open.
On Error Resume Next
Set xlObj = GetObject(, "Excel.Application")
On Error GoTo 0
If xlObj Is Nothing Then Set xlObj = CreateObject("Excel.Application")