I am fairly new to VBA but am trying to upload data from an Excel Workbook to an Access database table from a computer that does not have Access installed. I have searched for a solution online but haven't found anything yet that I can get to work with my code.
The error code I am getting is...429 cannot create activex component
I have some VBA code set up in the Excel workbook which calls a Sub in Access [which works on a machine which has Access installed] but I don't know what the correct code should be if the machine doesn't have Access installed.
Sub Upload_SiteObsData_Excel_To_Access(Database_Path)
Database_Path = "\\Path\db1.mdb"
Dim acApp As Object
Dim db As Object
Set acApp = CreateObject("Access.Application")
acApp.OpenCurrentDatabase ("\\Path\db1.mdb")
Set db = acApp
acApp.Run "Upload_SiteObsData_to_Access"
acApp.Quit
Set acApp = Nothing
End Sub
The procedure in Access is as follows:
Option Compare Database
Option Explicit
Dim Excel_Path As String
Dim Excel_Range As String
Dim UserNameOffice As String
Dim Excel_File_TechForm As String
Sub SetUp_Variables()
UserNameOffice = CreateObject("wscript.network").UserName
Excel_Path = "C:\Documents and Settings\" & UserNameOffice & "\Desktop\"
Excel_Range = "MyData"
Excel_File_TechForm = "SiteObsForm_v0.2.xls"
End Sub
Sub Upload_SiteObsData_to_Access()
SetUp_Variables
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "TBL_SiteObsData", Excel_Path & Excel_File_TechForm, True
End Sub
I would be extremely grateful for any help. Thanks in advance
I was just fooling around with some Excel VBA code and the following seemed to work:
Option Explicit
Sub Upload_Excel_to_Access()
Dim con As Object '' ADODB.Connection
Set con = CreateObject("ADODB.Connection") '' New ADODB.Connection
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data source=C:\Users\Public\Database1.accdb;"
con.Execute _
"INSERT INTO TBL_SiteObsData " & _
"SELECT * FROM [Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=C:\Users\Public\Book1.xlsm].[Sheet1$]"
con.Close
Set con = Nothing
End Sub
I think you'l have to find another way round this issue, without access installed, Excel cannot create the "Access.Application" object, it just flat-out doesn't know what access is.
Can you pull the data from Access instead?
I've done this the first time I connected Excel to Access via VBA, and I know for sure it works using the code that Gord Thomson provided. Establishing an ADODB connection and executing an append query.
Related
From MS Access I am generating several MS Access Workbooks. Via the following code I am getting the desired save location for all of the workbooks. The following code was working without issues a few days ago. Now it abruptly fails with no error number. MS Access crashes and I get a prompt to restart MS Access and a backup file is automatically created of the MS Access project I am working on.
Strangely the code works fine if I step through it with the debugger. It simply is not working at full speed.
UPDATE 1:
If I do the falling the save_location call works.
Private Sub make_report()
' TODO#: Change to late binding when working
Dim strSaveLocation as string
Dim xl as Excel.Application
dim wb as Excel.Workbook
strSaveLocation = save_location("G:\Group2\Dev\z_report")
Set xl=New Excel.Application
' do workbook stuff
With xl
strSaveLocation = strSaveLocation & "\report_name.xlsx"
wb.SaveAs strSavelLocation, xlOpenXMLWorkbook
End With ' xl
Set xl=nothing
End Sub
If I call the save_location function like this it abruptly crashes MS Access. It doesn't throw an error or anything. It just crashes.
Private Sub make_report()
' TODO#: Change to late binding when working
Dim strSaveLocation as string
Dim xl as Excel.Application
dim wb as Excel.Workbook
Set xl=New Excel.Application
' do workbook stuff
With xl
' the call to save_location is inside of the xl procedure
strSaveLocation = save_location("G:\Group2\Dev\z_report")
strSaveLocation = strSaveLocation & "\report_name.xlsx"
wb.SaveAs strSavelLocation, xlOpenXMLWorkbook
End With ' xl
Set xl=nothing
End Sub
By moving the save_location call inside the Excel.Application work string it fails. I don't understand why.
Private Function save_location(Optional ByVal initialDir As String) As String
On Error GoTo err_trap
Dim fDialog As Object
Dim blMatchIniDir As Boolean
Set fDialog = Application.FileDialog(4) ' msoFileDialogFolderPicker
With fDialog
.Title = "Select Save Location"
If NOT (initialDir=vbnullstring) then
.InitialFileName = initialDir
End If
If .Show = -1 Then
' item selected
save_location = .SelectedItems(1)
End If
End With
Set fDialog = Nothing
exit_function:
Exit Function
err_trap:
Select Case Err.Number
Case Else
Debug.Print Err.Number, Err.Description
Stop
Resume
End Select
End Function
Actions tried:
Decompile project and recompile
Create new MS Access project and import all objects
Compact and repair
Reset all reference
Notes:
I am using the client's system and
I don't know of any system updates
Client's system is a virtual desktop via VMWare
Office 2013
Windows 7 Pro
while i am not sure if this is the specific problem - but if it is the case, it messes with anything VBA. Check the folder names and file names for any apostrophes. While windows allows this, an apostrophe will be seen in VBA as a comment, and will crash it. Have the client walk you through the exact file that he selects to confirm there is no apostrophe character in the filename or folder name.
I am trying to set up a "Launcher" database which contains VBA code that will open a second database which is password protected. I can then convert the launcher db to accde so the VBA containing the password cannot be read.
I have the following code so far.
Private Sub Form_Load()
Dim acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String
strDbName = "C:\database Folder\secureDB.accdb"
Set acc = New Access.Application
acc.Visible = True
Set db = acc.DBEngine.OpenDatabase(strDbName, False, False, ";PWD=swordfish")
acc.OpenCurrentDatabase (strDbName)
Application.Quit
End Sub
When the launcher db is opened a form loads which subsequently fires the above code. It works but the problem is the last line which is intended to close the launcher db only but closes both databases. I have also tried opening the main database using Shell but am unable to pass the password this way.
How can I close the first database while keeping the second open?
You can use the following:
Private Sub Form_Load()
Dim acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String
strDbName = "C:\database Folder\secureDB.accdb"
Set acc = New Access.Application
acc.Visible = True
acc.OpenCurrentDatabase strDbName, False, "swordfish"
Set db = acc.CurrentDb() 'Don't know why you want a reference to the db
acc.UserControl = True
Application.Quit
End Sub
The relevant part is acc.UserControl = True, that forces the DB to stay visible and stops it from closing as soon as the reference to the Application object gets destroyed.
A sample database that stores the main database password encrypted with a salted user password can be found in this answer
I was having trouble getting the accepted answer to work properly. I was able to make work with:
Public Function OpenAccessDb(strVerPath, strFileName, sRecordset, strPwd)
'You may also need to have the following References Added:
'Microsoft Access 16.0 Object Library & Microsoft Office 16.0 Access Database Engine Object
'Visual Basic for Applications// Microsoft Excel 16.0 Object Library// OLE Automation//
'Microsoft Forms 2.0 Object Library// Microsoft Outlook 16.0 Object Library// Microsoft Office 16.0 Object Library
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
Dim sPath As String
'sPath = GetProperDirectory(strVerPath, strFileName) ' you can bypass this function by setting the path manually below and commenting this out.
sPath = "C:\database Folder\secureDB.accdb"'manually set the path here and comment out line above
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath, False, True, "MS Access;PWD=" & strPwd)
Set oRS = oDB.OpenRecordset(sRecordset)
''paste to call this function
''note this function utilizes the GetProperDirectory function.
''The GetProperDirectory function uses xxxxx as the location source
''therefore the strVerPath should start after \xxxxx\yyyyyy\yyyyy\DB.accdb
'strVerPath = "\yyyyyy\yyyyy\"
'strFileName= "DB.accdb"
'sRecordSet= "table in access DB" 'the table you are sending the data to
'strPwd = "password' 'this is the password that allows access to the database
'booOpenSend= OpenAccessDb(strVerPath, strFileName, sRecordSet, strPwd)
''end paste
End Function
I'm trying to automate exporting of query results from Access 2010 to Excel 2010. It is not easy because Access is using linked tables (SQL Server 2008 R2). I know that is can be done manually but I would really like to automate this process.
When I tried to step though the following VBA code located in Access, I get to this line and then it just running and running and never gets past this point
Set wbTarget = XL.Workbooks.Open("H:\TATData\Test.xlsx")
(no error messages)
I've tested the query before I copied it into the VBA Editor, so I know the query works and it's very fast, but not with automation. I also set up MS Excel library in Access that is needed.
Please help to figure out what needs to be done to get this to work.
I had to kill Access to get it to stop running.
Here is my code:
Public Sub ExportToExcel()
'Step 1: Declare your variables
Dim XL As Excel.Application
Dim excelApp As Object
Dim wbTarget As Workbook
Dim sht As Worksheet
Dim qdfTestData As QueryDef
Dim rsTestData As Recordset
Dim strSQL As String
Dim i As Integer
strSQL = "SELECT dbo_Patient.firstnm, dbo_Patient.lastnm, dbo_Sample.SampleDt, dbo_Test.TestTypeCd "
strSQL = strSQL & "FROM (dbo_Patient INNER JOIN dbo_Sample ON dbo_Patient.PatientId = dbo_Sample.PatientId) INNER JOIN dbo_Test ON dbo_Sample.SampleID = dbo_Test.SampleId "
strSQL = strSQL & "WHERE (((dbo_Test.TestTypeCd)='FL_XM_ALLO'));"
'set up reference to the query to export
CurrentDb.QueryDefs.Delete ("qrTest")
'set up reference to the query to export
Set qdfTestData = CurrentDb.CreateQueryDef("qrTest", strSQL)
'Execute the query
Set rsTestData = qdfTestData.OpenRecordset()
'Create a new Excel instance.
Set excelApp = CreateObject("Excel.Application")
'Set reference to the export workbook
'Set wbTarget = XL.Workbooks.Open("H:\TATData\Test.xlsx")
Set wbTarget = excelApp.Workbooks.Add
Set sht = wbTarget.Worksheets("Sheet1")
'clear excel sheet
On Error GoTo 0
excelApp.Visible = True
On Error GoTo Errorhandler
wbTarget.Worksheets("Sheet1").Cells.ClearContents
'Use paste from recordset to put in excel sheet
wbTarget.Worksheets("Sheet1").Cells(2, 1).CopyFromRecordset rsTestData
'clear excel sheet
Errorhandler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Sub
'wbTarget.Save
End Sub
You're doing this in a more difficult way than necessary. To directly export your query qrTest, use
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qrTest", _
"H:\TATData\Test.xlsx", True
(this will create an unformatted sheet)
or
DoCmd.OutputTo acOutputQuery, "qrTest", acFormatXLSX, "H:\TATData\Test.xlsx", False
(this will create a formatted sheet)
Side note: If
Set wbTarget = XL.Workbooks.Open("H:\TATData\Test.xlsx")
doesn't work, this cannot be caused by your query or anything in Access. Does this file itself have any ODBC connections?
So I navigated to the following MSDN Resource Page that addresses how to use ADO objects. My problem is that I cannot get it to work.
What I am trying to do is open a CSV file and read it line-by-line, then create SQL INSERT statements to insert the records into an existing Table in Access 2010. I have tried to find an easier method of doing this, but this appears to be my only option. doing this with the included tools, but so far, I haven't had any luck.
The main issue here is that I have CSV files with inconsistent headings. I want to import 5 files into the same table, but each file will be different depending on which fields contained data. Those fields with no data in them were ignored during the extract. This is why I can't use something like DoCmd.TransferText.
So, now I need to create a script that will open the text file, read the headers in the first line and create a SQL INSERT statement dependent on the configuration of that particular file.
I have a feeling that I have a good handle on how to appraoch the issue, but no matter what I try, I can't seem to get things working using ADO.
Could anyone explain how I can achieve this? My sticking point is getting the Access DB to receive information from the CSV files via ADO.
Instead of reading the CSV file line-by-line, then doing something with each line, I think you should open the file as an ADO recordset. And open a DAO recordset for your Access destination table.
You can then iterate through the fields in each row of the ADO recordset and add their values into a new row of the DAO recordset. As long as the destination table includes fields with the same names and compatible data types as the CSV fields, this can be fairly smooth.
Public Sub Addikt()
#If ProjectStatus = "DEV" Then
' needs reference for Microsoft ActiveX Data Objects
Dim cn As ADODB.Connection
Dim fld As ADODB.Field
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
#Else ' assume PROD
Const adCmdText As Long = 1
Const adLockReadOnly As Long = 1
Const adOpenForwardOnly As Long = 0
Dim cn As Object
Dim fld As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
#End If
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Dim db As DAO.Database
Dim rsDao As DAO.Recordset
Dim strConnectionString As String
Dim strName As String
Dim strSelect As String
strConnectionString = "Provider=" & _
CurrentProject.Connection.Provider & _
";Data Source=" & cstrFolder & Chr(92) & _
";Extended Properties='text;HDR=YES;FMT=Delimited'"
'Debug.Print strConnectionString
cn.Open strConnectionString
strSelect = "SELECT * FROM " & cstrFile
rs.Open strSelect, cn, adOpenForwardOnly, _
adLockReadOnly, adCmdText
Set db = CurrentDb
Set rsDao = db.OpenRecordset(cstrDestination, _
dbOpenTable, dbAppendOnly + dbFailOnError)
Do While Not rs.EOF
rsDao.AddNew
For Each fld In rs.Fields
strName = fld.Name
rsDao.Fields(strName) = rs.Fields(strName).value
Next fld
rsDao.Update
rs.MoveNext
Loop
rsDao.Close
Set rsDao = Nothing
Set db = Nothing
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
This is the Declarations section of the module where I saved that procedure:
Option Compare Database
Option Explicit
#Const ProjectStatus = "DEV" '"DEV" or "PROD"
Change the values for these constants to test it on your system:
Const cstrDestination As String = "tblMaster"
Const cstrFile As String = "temp.csv"
Const cstrFolder As String = "C:\share\Access"
Note the folder name does not include a trailing backslash.
You will want to adapt that procedure to pass the file name as a parameter instead of leaving it as a constant. And, if your CSV files are stored in more than one directory, you will want to pass the folder name as a parameter, too.
Hopefully showing you how to do it for one file will be enough and you can then take it from here to handle all your CSV files. Also consider adding error handling.
I think the previous answer is unnecessarily complicated. All you need to do it send an XMLHTTP request. That fetches the CSV data as a string, which can then be parsed into a table.
I've posted a VBA subroutine that does that in an answer to a similar question. Documentation of where I found the techniques is in the code comments. I've run it in Access 2019, and it works.
I'm working on a Access database which generates some mails with mail merge called from VBA code in the Access database. The problem is that if I open a new Word document and start the mail merge (VBA), Word opens the same Access database (which is already open) to get the data. Is there any way to prevent this? So that the already opened instance of the database is used?
After some testing I get a strange behavior: If I open the Access database holding the SHIFT-Key the mail merge does not open an other Access instance of the same database. If I open the Access database without holding the key, I get the described behavior.
My mail merge VBA code:
On Error GoTo ErrorHandler
Dim word As word.Application
Dim Form As word.Document
Set word = CreateObject("Word.Application")
Set Form = word.Documents.Open("tpl.doc")
With word
word.Visible = True
With .ActiveDocument.MailMerge
.MainDocumentType = wdMailingLabels
.OpenDataSource Name:= CurrentProject.FullName, ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
SQLStatement:="[MY QUERY]", _
SQLStatement1:="", _
SubType:=wdMergeSubTypeWord2000, OpenExclusive:=False
.Destination = wdSendToNewDocument
.Execute
.MainDocumentType = wdNotAMergeDocument
End With
End With
Form.Close False
Set Form = Nothing
Set word = Nothing
Exit_Error:
Exit Sub
ErrorHandler:
word.Quit (False)
Set word = Nothing
' ...
End Sub
The whole thing is done with Access / Word 2003.
Update #1
It would also help if someone could tell me what the exact difference is between opening Access with or without the SHIFT-Key. And if it is possible to write some VBA code to enable the "features" so if the database is opened without the SHIFT-Key, it at least "simulates" it.
Cheers,
Gregor
When I do mailmerges, I usually export a .txt file from Access and then set the mail merge datasource to that. That way Access is only involved in exporting the query and then telling the Word document to do the work via automation, roughly as follows:
Public Function MailMergeLetters()
Dim pathMergeTemplate As String
Dim sql As String
Dim sqlWhere As String
Dim sqlOrderBy As String
'Get the word template from the Letters folder
pathMergeTemplate = "C:\MyApp\Resources\Letters\"
'This is a sort of "base" query that holds all the mailmerge fields
'Ie, it defines what fields will be merged.
sql = "SELECT * FROM MailMergeExportQry"
With Forms("MyContactsForm")
' Filter and order the records you want
'Very much to do for you
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause()
End With
' Build the sql string you will use with this mail merge
sql = sql & sqlWhere & sqlOrderBy & ";"
'Create a temporary QueryDef to hold the query
Dim qd As DAO.QueryDef
Set qd = New DAO.QueryDef
qd.sql = sql
qd.Name = "mmexport"
CurrentDb.QueryDefs.Append qd
' Export the data using TransferText
DoCmd.TransferText _
acExportDelim, , _
"mmexport", _
pathMergeTemplate & "qryMailMerge.txt", _
True
' Clear up
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'Start Code Block:
'OK. Access has built the .txt file.
'Now the Mail merge doc gets opened...
'------------------------------------------------------------------------------
Dim appWord As Object
Dim docWord As Object
Set appWord = CreateObject("Word.Application")
appWord.Application.Visible = True
' Open the template in the Resources\Letters folder:
Set docWord = appWord.Documents.Add(Template:=pathMergeTemplate & "MergeLetters.dot")
'Now I can mail merge without involving currentproject of my Access app
docWord.MailMerge.OpenDataSource Name:=pathMergeTemplate & "qryMailMerge.txt", LinkToSource:=False
Set docWord = Nothing
Set appWord = Nothing
'------------------------------------------------------------------------------
'End Code Block:
'------------------------------------------------------------------------------
Finally:
Exit Function
Hell:
MsgBox Err.Description & " " & Err.Number, vbExclamation, APPHELP
On Error Resume Next
CurrentDb.QueryDefs.Delete "mmexport"
qd.Close
Set qd = Nothing
Set docWord = Nothing
Set appWord = Nothing
Resume Finally
End Function
To use this, you need to set up your Resources\Letters subfolder and put your mailmerge template word file in there. You also need your "base" query with the field definitions in your Access App (in the example, it is called MailMergeExportQry. But you can call it anything.
You also need to figure out what filtering and sorting you will do. In the example, this is represented by
sqlWhere = GetWhereClause()
sqlOrderBy = GetOrderByClause
Once you have got your head round those things, this is highly reusable.