I am getting a runtime error:
-2147217900 "Invalid SQL statement" on this line of my code:
Call objRecordset.Open("frmTotalInventory", , , adLockBatchOptimistic)
I have this same code working in another MS Access project and the only difference is the form that it is referencing which is "frmTotalInventory".
I checked and the library references match between the two Access projects and I am not sure at all why I would be getting an SQL statement error. The other Access project has "InventoryForm" as the form referenced for the Recordset.Open if that helps. Full code listed below. If anyone has any ideas please let me know. Is frm a reserved word?
Option Compare Database
Private Sub Command1_Click()
On Error GoTo ErrorHandlerCall
GoTo ProgramStart 'Skip over error handling until needed
'******************
ErrorHandlerCall: '**ERROR HANDLING**
Call Error.ErrorHandler(ByVal workbook) '******************
ProgramStart:
'Open file dialog opens and returns the selected filepath from OpenFile module
Call OpenFileDialog(FilePath)
'Reset progress bar and progress label to 0
'so each time you import the values will reset
PB1 = 0
ProgressPercent.Caption = 0 & "%"
Dim ExcelApp As Excel.Application
Set ExcelApp = CreateObject("Excel.Application")
Set workbook = ExcelApp.Workbooks.Open(FileName:=(FilePath))
'This is needed to add records with VBA
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordset.ActiveConnection = CurrentProject.Connection
Call objRecordset.Open("frmTotalInventory", , , adLockBatchOptimistic)
'Loop runs within the LastRowFinder module to determine
'the last row used in the formatted workbook
Call GetLastRow(ByVal workbook, LastRowUsed)
'Math - This has to be after the "Call GetLastRow" in order for it to return
'the LastRowUsed variable that is used for calculating progress
Dim PbIncrement As Variant
PbIncrement = 1 / LastRowUsed
PbIncrement = Round(PbIncrement, 6) * 100
Call AddRecordsLoop(ByVal objRecordset, ByVal workbook, LastRowUsed, PbIncrement)
'Ensures progress bar is at 100% after adding all records
PB1 = 100
ProgressPercent.Caption = Round(PB1, 0) & "%"
'Close Excel Process
If Not (ExcelApp Is Nothing) Then ExcelApp.Quit
End Sub
Well I could not feel more stupid. This entire time I did not realize I was referencing the form instead of a table.. the names had me confused between my two projects as the one I am working on was not created by me. Thank you for making me realize how dumb someone can actually be.
The solution was to change "frmTotalInventory" to "tblInventoryList" which is the name of the actual TABLE I was trying to reference.
Related
How can I import an excel worksheet into an MS Access table every time new data is added to the worksheet? Meaning every time I update my excel worksheet it would automatically update the ms access table?
I searched the internet and it seems there are several ways that it can be done, however I can't find a method that does exactly what I want. What I have so far isn't working nor does it do what I want it to do in the end. However, it is a start.
As I said I want vba to continuously update my access table through the excel worksheet. Right now the code isn't working. It keeps saying "path not found."
I tried debugging, but I haven't been able to figure out what was wrong with the path. This is what I have so far. Any suggestions on how to fix my code and or any suggestions for an easier way?
Sub ExportToAccess()
Dim oSelect As Range, i As Long, j As Integer, sPath As String
Sheet1.Activate
Set oSelect = Application.InputBox("Range", , Range("A1").CurrentRegion.Address, , , , , 8)
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
ChDir ActiveWorkbook.Path
sPath = Application.GetOpenFilename("Access * test.accdb\")
If sPath = "False" Then Exit Sub
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath)
Set oRS = oDB.OpenRecordset("ImportedData")
For i = 2 To oSelect.Rows.Count
oRS.AddNew
For j = 1 To oSelect.Columns.Count
oRS.Fields(j) = oSelect.Cells(i, j)
Next j
oRS.Update
Next i
oDB.Close
If MsgBox("Open the table?", vbYesNo) = vbYes Then
Dim oApp As Access.Application
Set oApp = New Access.Application
oApp.Visible = True
oApp.OpenCurrentDatabase sPath
oApp.DoCmd.OpenTable "ImportedData", acViewNormal, acReadOnly
oApp.DoCmd.GoToRecord , , acLast
DoEvents
End If
End Sub
Problem solved:
Though the method I used to solve my problem worked for me it might not be what most people would be expecting when seeing this post, however I still think it could be useful to some. Even though the solution I came up with is very simple. Instead of directly writing some code to transfer the data in my worksheet to an access table I simply had my vba code copy and paste the data that was entered into worksheet 1 then paste it into worksheet 2, then I linked worksheet 2 to an access table using the external data import function in access.
Im making a macro on excel that import data from MySQL (with querytables.add and using OBCD) and every time i run the macro it creates a new connection and its a waste of time and space. Is there a function to know if a cell/sheet has a connection on it so i dont have to import the data again and create a new connection or a code to know when was the last time the connection was refreshed.
i looked up for something but it seems there is nothing like it, so maybe and alternative way to do it will be useful, thanks!
Code:
Worksheets("Hoja1").Activate
Dim sqlstring As String
Const connstring As String = "ODBC;DSN=blabla;UID=blabla;PWD=blabla"
if "***Range("A1") has a connection***" then
ActiveWorkbook.Connections("Conexión").Refresh 'actualize the connection previously made
Else 'import the table from sql server
sqlstring = vbNullString
sqlstring = "SELECT * FROM ExTable WHERE year > '2012'"
With ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Range("A1"), Sql:=sqlstring)
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False
End With
I just built and tested this nifty little procedure that checks if a connection exists for a specific worksheet range and if so, refreshes it. I also left a spot to add the part where it creates a new one if it's not found.
Warning - as written, this will potentially fail if there is another connection listed on the worksheet outside the desired range and it checks that connection first while there is also an existing connection within the desired range. You'll need to adjust for that.
Sub RefreshMakeConnection()
Dim cnT As Connections
Set cnT = ThisWorkbook.Connections
Dim sWS As String
sWS = "Hoja1"
Dim cn As WorkbookConnection
For Each cn In cnT
If cn.Ranges(1).Parent.Name = sWS Then
With Worksheets(sWS)
If Not Intersect(.Range("A1"), cn.Ranges(1)) Is Nothing Then
cn.Refresh
Else
'code to create new connection
End If
End With
End If
Next
End Sub
Perhaps you may find the connections name?
Sub test()
Dim ItemConnection As Variant
Dim TotalConnections As Connections: Set TotalConnections = ThisWorkbook.Connections
For Each ItemConnection In TotalConnections
MsgBox ItemConnection.Name
Next ItemConnection
End Sub
PS: Variant is because I didn't find a way to declare connection as a single item of connection
Before I begin, here is some history:
Created VBA in Excel to open and read three (3) Excel files (includes itself) and input data into charts/tables/graphs into a PowerPoint presentation. This version runs beautifully. VBA kicked off by a User Form
Modified code to fit a requirement passed down to me. This one causes the error of VBA Method 'Activate' of object 'ChartData' when loading a graph in one particular slide. This data is transferred from the sheet that kicks off the VBA.
I was unable to recreate this error steadily until I started saving the Excel file that kicks off the script when it asked. Now I can.
NO VBA resides in the powerpoint presentation.
Users testing this experience the error first time around. I do not. However, I do in the further iterations I do after saving the Excel book after either a successful or unsuccessful run.
Screen behaviors I've noticed when error occurs:
Only happens after I save the Excel that kicked off the procedure and I test the procedure again when trying to re-create error.
PowerPoint presentation becomes the 'activated' application while VBA runs in background
Happens on the same slide and chart (yes, using object labels in PowerPoint).
When error occurs and I break code, I can NOT close PowerPoint or Excel using the File menu. I HAVE to use the 'Red X' in the upper right hand corner to close. The ribbons and tabs are also unusable (do not react to a clicking event). Microsoft does ask the Save option.
What I've tried:
Walking through code and explicitly closing objects after they've been opened and are not required.
Varying the placement of the ScreenUpdating, etc. Application processes
Here is the function where it trips. It trips up at trpChartData.Activate for a particular graph (which is shapeName):
Function insGraphInfo(ByVal numOfSlide As Integer, ByVal shapeName As String, ByVal cellToMod As String, ByVal valToIns As Variant) As Variant
'Inserts data into a CHART TYPE graph
On Error GoTo ERR_INS_GRAPH
Dim trpChart As PowerPoint.Chart
Dim trpChartData As ChartData
Dim trpWkBk As Excel.Workbook
Dim trpChartSheet As Excel.Worksheet
Dim errString As String
Set oPPTSlide = oPPTFile.Slides(numOfSlide)
With oPPTSlide
.Select
End With
Set oPPTShape = oPPTFile.Slides(numOfSlide).Shapes(shapeName)
Set trpChart = oPPTShape.Chart
Set trpChartData = trpChart.ChartData
Debug.Print "Activating: " & shapeName & " in slide number: " & numOfSlide
errString = "Activating: " & shapeName & " in slide number: " & numOfSlide
trpChartData.Activate
Debug.Print shapeName & " activated."
errString = shapeName & " activated."
errString = "Setting Workbook and Worksheet Objects"
Set trpWkBk = trpChartData.Workbook
Set trpChartSheet = trpWkBk.Worksheets(1)
errString = "Inserting Value into appropriate cell)"
With trpChartSheet
.Range(cellToMod).Value = valToIns
End With
insGraphInfo = valToIns
errString = "Refreshing Chart."
With oPPTShape 'Refreshes
.Chart.ChartData.Activate
.Chart.ChartData.Workbook.Close
.Chart.Refresh
End With
Set trpWkBk = Nothing
Set oPPTSlide = Nothing
Set oPPTShape = Nothing
Exit Function
ERR_INS_GRAPH:
MsgBox "An error occurred while: " & errString
Resume Next
End Function
Excel and PowerPoint are created by two different teams of developers.
PowerPoint.Chart is not the same as Excel.Chart
Yes, they look the same and you would think that you have the same level of access to their properties, but that is where you would be wrong. The PowerPoint version is very limited.
Anyway, as far I can tell, you went wrong when you declared
Dim trpChartData As ChartData
Instead of
Dim trpChartData As PowerPoint.ChartData
As Rachel pointed out,
trpChartData is declared without a library qualifier and thus defaults to Excel.ChartData
In addition to that you never cleared trpChartData with
Set trpChartData = Nothing
I also don't see where you .Quit the Excel application for the Chart.Workbook that must have been created. This could explain why there were versions of Excel open in the Task Manager afterwards. Try adding this...
Dim xlApp as Excel.Application
'
'
Set xlApp = .Chart.ChartData.Workbook.Application
'
'
xlApp.Quit
Set xlApp = Nothing
I've been trying to use transfer spreadsheet methods but they appear to require an output path.
I just need to find out how to take a given query and simply "open up" an Excel file that contains the query output. I don't need the file actually saved anywhere.
You can open up your file without saving it by creating an Excel instance (or grabbing an existing one) and using the CopyFromRecordset function of the Excel.Range object.
This assumes your data are in an ADO recordset. You need to have references to Microsoft Excel XX.0 Object Library and Microsoft ActiveX Data Objects X.X Library` (if you are using ADO. If you use DAO then use whatever DAO reference you need)
I use this to grab an an Excel app or create a new one is Excel is not open already. I use WasANewInstanceReturned to figure how I need to clean up the Excel resources at the end. (Obviously I don't want to quit Excel if it is being use by something else).
Function GetExcelApplication(Optional ByRef WasANewInstanceReturned As Boolean) As Excel.Application
If ExcelInstanceCount > 0 Then
Set GetExcelApplication = GetObject(, "Excel.Application")
WasANewInstanceReturned = False
Else
Set GetExcelApplication = New Excel.Application
WasANewInstanceReturned = True
End If
End Function
Then grab that instance
Dim ApXL As Excel.Application, WasANewInstanceReturned as Boolean
Set ApXL = GetExcelApplication(WasANewInstanceReturned)
Add a workbook
Dim wbExp As Excel.Workbook
Set wbExp = ApXL.Workbooks.Add
Grab the first sheet
Dim wsSheet1 As Excel.Worksheet
Set wsSheet1 = wbExp.Sheets(1)
Put your recordset's field names in the first row
Dim fld As ADODB.Field
Dim col As Integer
col = 1
With wsSheet1
For Each fld In rst.Fields
.Cells(1, col).Value = fld.Name 'puts the field names in the first row
End With
col = col + 1
Next fld
End With
Then move the data just below the field names
wsSheet1 .Range("A2").CopyFromRecordset rst
Voila! You have an excel file open, with your data that has not been saved anywhere!
I usually set ApXL.ScreenUpdating = False before doing any of this and ApXL.ScreenUpdating = True at the end.
I'll let you stitch this together for your needs.
The file must be saved somewhere for Excel to open it.
If the dataset is small enough, you can use copy/paste (no file here). Otherwise, just use the %TEMP% folder for the file location.
Edit:
One simple way to get the TEMP folder is to use =Environ("TEMP")
I open and export a query from access to excel. First I created a worksheet in excel and saved it. Then I created a module in the vba part of Access (2013):
Option Compare Database
' Testtoexporttoexcel'
Function ExportQuerytoExcel()
On Error GoTo ExportQuerytoExcel_Err
' Exports the query to excel to a sheet named Nameofyoursheet
DoCmd.TransferSpreadsheet acExport, 10, "nameofyourquery", "yourPath:\nameofyourworkbook", False, "Nameofyour worksheet"
ExportQuerytoExcel_Exit:
Exit Function
ExportQuerytoExcel_Err:
MsgBox Error$
Resume ExportQuerytoExcel_Exit
End Function
-----then add another function that says:
Option Compare Database
Function OpenExcelFromAccess()
'Opens Excel to the chart
Dim MYXL As Object
Set MYXL = CreateObject("Excel.Application")
With MYXL
.Application.Visible = True
.workbooks.Open "Yourpath:\nameofyourworkbook"
End With
'Application.Quit
End Function
hope this helps, this is my first time answering a question.
Aloha
I have a shared, protected workbook that has a button to bring up a search form. There are two fields on this form, txtYear and cbxRegion, that I need enabled. Whenever I try to open the fields, it works until I exit Excel.
I have tried unprotecting the workbook, unsharing it, and commenting out any reference in the VBA to reprotecting the form. And still, even the edited VBA reverts back to the original.
This is the section of code referring to the form I need enabled. Any assistance would be greatly appreciated. I'm using Excel 2010.
Private Sub UserForm_Initialize()
Dim strDb As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim row As Integer
Dim AccessVersionID As String
cbxRegion.Value = Worksheets("Parameters").Cells(5, 14)
Me.txtYear = Worksheets("Parameters").Cells(4, 7)
Me.chkBoth = Worksheets("Parameters").Cells(9, 2)
Me.chkConsultant = Worksheets("Parameters").Cells(7, 2)
Me.chkInHouse = Worksheets("Parameters").Cells(8, 2)
'Set region values
'Open connection
'Select Case SysCmd(acSysCmdAccessVer)
'Case 11: AccessVersionID = "2003"
'End Select
'If AccessVersionID = "2003" Then
' strDb = Worksheets("Parameters").Cells(17, 2).Value 'This will reference the path
'Else
strDb = Worksheets("Parameters").Cells(18, 2).Value
'End If
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDb & ";"
Set rs = New ADODB.Recordset
'Get recordset
With rs
Set .ActiveConnection = cn
.Open "Select * From LookupRegion"
.Requery
End With
'Add regions
row = 0
With rs
.MoveFirst
Do Until .EOF
cbxRegion.AddItem ![region]
cbxRegion.list(row, 1) = ![RegionName]
row = row + 1
.MoveNext
Loop
End With
'Close the recordset
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
I managed to get it to work. In order, I:
Unshared the workbook
Unprotected the workbook
Saved, closed, and reopened the workbook to make sure the settings stayed
Enabled the fields
Saved, closed, and reopened the workbook to make sure the settings stayed
Protected the workbook
Shared the workbook (as required by the specifications I was given, I would rather not share it but it really isn't my call here)
Saved, closed, and reopened the workbook to make sure the settings stayed
And now it works exactly as I need it to.
As far as I am concerned, the best advice anyone can give you for a shared workbook is: don't use them.
Shared Workbooks are impossible to troubleshoot. Their aberrant behaviour cannot be fixed. They don't follow any logic. Once a shared workbook starts acting up and behaving strangely, you have reached the inevitable end stage. Nothing can be done to fix it. The behaviour is not necessarily reproducible.
If you need simultaneous multi-user write access to a dataset, then Excel is the wrong tool. Use a database.
Don't use shared workbooks.