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.
Related
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.
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 been searching for some time on how exactly to go about this, but I keep coming up with a large number of possible ways that come close, but never really give me exactly the sort of thing I'm looking for. The concept is pretty simple I need to open a certian .xls file using some VBA code in Access 2010. Once the file is opened I need to insert data and do some things to the file then save the file as a different filename and close the file. I also need it to close excel if it was not already open and if it was open I need it to leave excel alone and not save/close anything other than the template.xls file I am working with. I currently have code that will do part of this provided Excel is not already open at the time the script runs. When excel is already opened I get the following error;
"Run-time'91': Object variable or With block variable not set."
When I click debug I get the following line highlighted
x.ActiveWorkbook.SaveAs fileName:=savedfilename
Here is the code without all the junk that doesn't relate to the issue. I have cobbled together using examples from various sites.
Dim DateSampled As String
Dim strPath As String
Dim TemplatePath As String
Dim x As Excel.Application
Dim xBook As Excel.Workbook
Dim xSheet As Excel.Worksheet
DateAsString = Format(DateSampled, "MMDDYYYY")
savedfilename = strPath & "\" & TrainNum & "-" & DateAsString & ".xls"
TemplatePath = "B:\template.xls"
Set x = CreateObject("Excel.Application")
x.Visible = False
Set xBook = GetObject(TemplatePath)
xBook.Windows(1).Visible = True
Set xSheet = xBook.Worksheets(1)
'---------------CODE DOES STUFF WITH THE FILE -----------------------
x.DisplayAlerts = False
x.ActiveWorkbook.SaveAs fileName:=savedfilename
x.DisplayAlerts = True
x.ActiveWorkbook.Close
Set x = Nothing
Set xBook = Nothing
Set xSheet = Nothing
A little background to the title: I've written a macro that gets called on workbook open. It opens a [shared] workbook on a shared directory and pulls in some information to the workbook the user is using.
Any user working with this sheet already has the shared directory mapped to their computer (and the macro finds the correct drive letter).
I've tested this worksheet multiple times with users in my office. I've also tested it and had two people open the workbooks simultaneously to confirm that the macros for both users are able to pull data from the shared workbook concurrently.
So far, I've had no issues.
This sheet then got rolled out to multiple other users in my company. All in all, about 40 people are expected to use this sheet (not necessarily at the same time.. just in total).
One of the users is located in Poland (I'm located in London).
When he opens the workbook, he gets a 'Microsoft Excel is waiting for another application to complete an OLE action' notification. The notification comes with an 'OK' button. Pressing this button seems to have no effect and the workbook effectively hangs on this notification.
I'm having a lot of trouble resolving this problem as I have not been able to replicate it. Does anyone have an idea why this would come up? Code below:
Sub PreliminaryDataImport()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim x As Variant
Dim usename As String
usename = Environ("USERNAME")
Dim xlo As New Excel.Application
Dim xlw As New Excel.Workbook, wkbk As New Excel.Workbook
Dim xlz As String, regions As String
Dim LRow As Long, LCell As Long, LRow2 As Long
Dim RegionList As String
RegionList = ""
xlz = Sheet1.Range("o1").Value & "\Region Planning\TestDB.xlsx"
Set xlw = xlo.Workbooks.Open(xlz)
If Not Sheet11.Range("S1").Value = xlw.Worksheets("validation") _
.Range("N1").Value Then
MsgBox "YOU ARE USING AN OUT OF DATE VERSION" & vbLf & _
"Please check your inbox or contact xxxx for the current version."
xlw.Close False
Set xlo = Nothing
Set xlw = Nothing
Call Module7.ProtectSheets
End
End If
x = CheckValidation(usename, xlw)
'~~ Check to see if User has access to view/modify.
'~~ If they have access, return regions
On Error Resume Next
For i = LBound(x) To UBound(x)
regions = regions + " --- " & x(i)
RegionList = RegionList + x(i) & ", "
Sheet1.Cells(i + 2, 33).Value = x(i)
Next
If Err.Number <> 0 Then
MsgBox "You do not have access to view or modify any regions."
xlw.Close False
Set xlo = Nothing
Set xlw = Nothing
End
Else
MsgBox "You have access to view and modify the following regions:" & vbLf _
& vbLf & regions & "---"
I believe the issue occurs somewhere within this section of the code as the msgbox on the last line doesn't show up prior to the notification. I haven't been able to run in debug from his machine as he's located remotely and that would be a large effort (should only be done if absolutely necessary).
Anyone have ideas on why this one user is getting this error? I'm particularly confused because it's only him having the issue.
One thing that looks a bit suspicious is that you're creating a new instance of Excel
Dim xlo As New Excel.Application
Normally this is done so that a hidden instance of Excel can be used to open a workbook that you don't want to show to the user, but I don't see any code to hide this second instance, i.e.:
xlo.Visible = False
Since you open and close the shared workbook quickly, and you have ScreenUpdating = False in your main Excel instance, you may be able to do this in your main Excel instance without the overhead of creating a new Excel instance.
Also you aren't calling xlo.Quit to close the second Excel instance, so it may hang around in the background...
An alternative approach would be to use OleDb to read from the shared workbook, in which case you don't need to open it at all.
There are a number of similar posts but nothing that does exactly what I want as simply as it needs to be for me to understand
I want to use Access 2007 VBA to open a csv file and replace the column headings row ie:
OldColumn1,OldColumn2
1,2
with
NewColumn1,NewColumn2
1,2
ie without disturbing the rump of data.
Then save and close.
I have tried this code, but it deletes my data:
Sub WriteFile()
Dim OutputFileNum As Integer
Dim PathName As String
PathName = Application.ActiveWorkbook.Path
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, "NewCol1" & "," & "NewCol2"
Close OutputFileNum
End Sub
Import or link to the .csv so that you have the recordset in your Access 2007 databases.
Write a query with NewColumn[x] as an alias for OldColumn[x].
Write vba code to use TransferText functionality or make a macro to do the same to export your query as a .csv file (overwriting the original csv if you want/need).
Obviously, there are plenty of bonus things you could do to automate and reproduce this concept for any number or types of files. But the above solution should work in an all MS Access environment.
Let me know if you would like details on any of these steps.
Further to my earlier comment, please see the method which uses the Excel reference:
Public Sub EditCsv()
Dim xlApp As Object
dim xlWbk As Object
Dim xlWst As Object
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open ".../Test.csv" 'Amend this to your needs
Set xlWst = xlWbk.Sheets(1)
'This assumes the columns are at the beginning of the file
xlWst.Range("A1") = "My New Column Name"
xlWst.Range("B1") = "My New Second Column Name"
xlWbk.Close -1 'Close and save the file here
xlApp.Quit
Set xlApp = Nothing
Set xlWbk = Nothing
Set xlWst = Nothing
End Sub