I used the following Access VBA code to open four different excel workbooks in a loop while I need to edit the excel data and then update the Access table through recordset.
xl.Application.DisplayAlerts = False
Set wb = xl.Workbooks.Open(fileName, ReadOnly = True, editable = True, notify = False)
Set ws = wb.Sheets("Sheet1")
Set ws2 = wb.Worksheets.Add
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fileName & ";Extended Properties=""Excel 8.0;HDR=YES;IMEX=1;"";"
*****Other Codes******
wb.Close savechanges:=False
Set wb = Nothing
Set xlc = Nothing
Set ws = Nothing
Set ws2 = Nothing
Set xl = Nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
However, even though I close the excel file without saving for all the four files, I still receive the following notice after the full loop.
with Set wb = xl.Workbooks.Open(fileName, ReadOnly = True, editable = True, notify = False), I was still not able to turn off the notice.
PS. I did not receive the read-write notification for all the four files, normally one or two, which really confused me.
Any recommendations for solving the issue?
Thanks in advance for all the help!
You can't manually control garbage collection in VBA but you can structure your data so that garbage collection is more predictable. The first thing I recommend is to place the Excel inter-op code in to it's own procedure that is called from your main loop. The reason is that when the procedure ends, the garbage collection will occur. Next time the loop calls the open procedure you will be working with a fresh set of object handles, instead of recycling the objects as you are currently doing. If you do it this way you never have to set your objects to nothing because they are destroyed as they go out of scope at the end of the procedure. Just be sure to always use local variables.
In order to do this without closing and opening Excel repetitively you need to get a handle on the currently running Excel instance. That is provided by the GetExcelApp procedure below.
EXAMPLE:
Private Sub YourMainLoop()
For Each fileName in fileNames
ProcessExcelData fileName
Next fileName
End Sub
Private Sub ProcessExcelData(ByVal fileName as String)
Dim xl As Object
Set xl = GetExcelApp
xl.Application.DisplayAlerts = False
Set wb = xl.Workbooks.Open(fileName, ReadOnly = True, editable = True, notify = False)
Set ws = wb.Sheets("Sheet1")
Set ws2 = wb.Worksheets.Add
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fileName & ";Extended Properties=""Excel 8.0;HDR=YES;IMEX=1;"";"
' Process the data, blah blah blah
wb.Close savechanges:=False
rs.Close
cn.Close
End Sub
Public Function GetExcelApp() As Object
' Returns open excel instance.
' If it doesn't exist, creates one to return
On Error GoTo ErrHandler
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")
Resume CleanExit
Else
ShowErrorMessageBox
End If
End Function
Related
I am facing an issue while exporting my Microsoft access data to an excel file.
It is giving me an error message of:
You selected more records than can be copied onto the Clipboard at one time. Divide the records into two or more groups, and then copy and paste one group at a time. The maximum number of records you can paste at one time is approximately 65,000.
The code that i am using:
FileCopy "S:\Users\File\Deposit.xls", strs & "\Deposit.xls"
Try this:
Select External data
Got to Export
Hit Excel
You will be given a choice to select the destination for your data
Select where you want to save your exported data
In the Specify Report Options Area- you have the option to select and tick Export Data With Formatting And Layout
You also have the option to open the destination file after the export operation is complete- tick if you want to utilise this option
Hit OK
You may now get the above error at this stage if you have ticked the Export Data With Formatting And Layout Option and are trying to export more than 65,000 data lines
When the data is exported you can then hit Close
Using VBA:
Sub transSpread()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
"tblSales", "C:\Sales.xls"
MsgBox "Sales spreadsheet created"
End Sub
Or:
Option Compare Database
Option Explicit
' be sure to select Microsoft Excel Object Library in the References dialog box
Public myExcel As Excel.Application
Sub CopyToExcel()
Dim conn As ADODB.Connection
Dim myRecordset As ADODB.Recordset
Dim wbk As Excel.Workbook
Dim myWorksheet As Excel.Worksheet
Dim StartRange As Excel.Range
Dim strConn As String
Dim i As Integer
Dim f As Variant
On Error GoTo ErrorHandler
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
Set conn = New ADODB.Connection
Set myRecordset = New ADODB.Recordset
With myRecordset
.Open "Employees", strConn, _
adOpenKeyset, adLockOptimistic
End With
Set myExcel = New Excel.Application
Set wbk = myExcel.Workbooks.Add
Set myWorksheet = wbk.ActiveSheet
myExcel.Visible = True
i = 1
With myRecordset
For Each f In .Fields
With myWorksheet
.Cells(1, i).Value = f.Name
i = i + 1
End With
Next
End With
Set StartRange = myWorksheet.Cells(2, 1)
StartRange.CopyFromrecordset myRecordset
myRecordset.Close
Set myRecordset = Nothing
myWorksheet.Columns.AutoFit
wbk.Close SaveChanges:=True, _
FileName:="C:\ExcelFile.xls"
myExcel.Quit
Set conn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical, _
"Automation Error"
Set myExcel = Nothing
Exit Sub
End Sub
In my Excel workbook, I can attach an Access database as an OLE object.
I now want to save a copy of this object (Access database) in another folder.
Here is my code:
If nameEnd = "ccdb" Then
'Access Type
Dim AccessApp As Object
Dim obja As OLEObject
Application.ScreenUpdating = False
Set obja = ActiveSheet.OLEObjects(i)
obja.Activate
obja.Visible = True
Set AccessApp = GetObject(, "Access.Application")
AccessApp.CurrentDatabase.SaveAs FileName:=fpath & "AttachmentAccess"
AccessApp.CurrentDb.ExportAsFixedFormat outputfilename:=saveFile & "Attachment DB", _
ExportFormat:=accdbExportFormatPDF
Set AccessApp = Nothing
Range("K2:Z300").Select
Application.ScreenUpdating = True
End If
I get the error "Object doesn't support this property or method" probably because "CurrentDatabase.SaveAs" does not exist as a property.
I think you used wrong property names.
As you write in the next line, it's not CurrentDatabase but CurrentDb. Moreover, the function isn't called SaveAs but MakeReplica. So, try this:
AccessApp.CurrentDb.MakeReplica PathName:=fpath & "AttachmentAccess"
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
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'm trying to write a vbscript to be able to checkout an excel file that is stored on sharepoint server.
Currently I can check the file out from SharePoint 2010: Link to open Excel file in edit-mode mode
However, I'm trying to check the file back in but not able to. I've searched and tried the checkout functions per http://msdn.microsoft.com/en-us/library/office/ff194456%28v=office.14%29.aspx but not able to.
Currently the code I have is
Sub CheckInFile
Dim ExcelApp, ExcelSheet, ExcelBook
Dim myURL
myURL = "http://server/Site/excel.xlsx"
Set ExcelApp = CreateObject("Excel.Application")
If (ExcelApp.WorkBooks.CanCheckIn(myURL) = True) Then
msgbox ("here")
ExcelApp.WorkBooks.Open (myURL)
ExcelApp.Application.WorkBooks.CheckIn myURL
ExcelApp.ActiveWorkbook.Close
' Quit Excel.
ExcelApp.Quit
' Clean Up
Set ExcelApp= Nothing
End If
End Sub
However the script stops and fails at the if statement, rather doesn't execute. Is there a similar vbscript function to check in a file ?
I struggled a LOT with this and spent many hours searching for a solution that worked in my particular environment. Here are my criteria that needed to be met:
Execute the process from my computer using vbscript file
Iterate through a list of ~200 excel spreadsheets
Check out each file
Make various conditional updates and save
Check the file back in again when updates are complete.
Below is an alternate solution for anybody in the future that, like me, tried the suggested approach and it didn't work. This is tested and working:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Dim MyVar ' so popup alerts narrate the process
' and help explain what is happening
' for those who want to see it step
' by step
Dim docPath
docPath = "\\your server\sites\Docs\sharepoint spreadsheet.xlsx"
' I believe this can be any document path
Set objWorkbook = objExcel.Workbooks.Open(docPath)
cco = objExcel.Workbooks.CanCheckOut(docPath)
MyVar = MsgBox ("can check out? " & cco, 0)
' -----------------------------------------------------
' this shows "False" every time. I still do not know how
' to get this to work, but thought it would be valuable
' to include for explanation
' -----------------------------------------------------
objExcel.Workbooks.CheckOut(docPath)
' -----------------------------------------------------
' this SUCCEEDS every time...as long as you have
' the ability to check out the document manually
' -----------------------------------------------------
MyVar = MsgBox ("Update cell", 0)
With objExcel.ActiveWorkbook.Worksheets(1)
objExcel.Cells( 1, 1 ).Value = "test value"
End With
MyVar = MsgBox ("Save the file", 0)
objWorkbook.Save
MyVar = MsgBox ("check in the file", 0)
objWorkbook.CheckIn
' -----------------------------------------------------
' This actually checks in the active document and *closes
' it* You don't have to have a separate command to close
' the file, e.g.
' objWorkbook.Close
' THIS WILL FAIL.
' -----------------------------------------------------
Set objWorkbook = Nothing
Just try this:
Dim ExcelApp, ExcelSheet, ExcelBook
Dim myURL = "http://server/Site/excel.xlsx"
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.WorkBooks.Open (myURL)
If (ExcelApp.ActiveWorkbook.CanCheckIn = True) Then
ExcelApp.Application.WorkBooks(myURL).CheckIn
ExcelApp.ActiveWorkbook.Close
' Quit Excel.
ExcelApp.Quit
' Clean Up
Set ExcelApp= Nothing
End If
Just change include below lines to your code:
ExcelApp.Visible = True
ExcelApp.DisplayAlerts = False
Thanks!
Dim oExcel
Dim strFileName
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
oExcel.DisplayAlerts = False
strFileName = "view_2019.xlsm"
'Checkin
If oExcel.Workbooks(strFileName).CanCheckIn = True Then
oExcel.Workbooks(strFileName).CheckIn SaveChanges=True,Comments="Updated"
MsgBox strFileName & " has been checked in."
Else
MsgBox "This file cannot be checked in at this time. Please try again later."
End If
set oExcel = nothing