Creating multiple linked tables in Access with VBA - excel

So I currently have this code
Public Sub DoTrans()
Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\db1.accdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]" & "namedrange1"
cn.Open scn
ssql = "INSERT INTO Table1 ([fdName], [fdOne], [fdTwo]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
cn.Execute ssql
End Sub
But this inserts into existing Access table. I'd like to be able to modify this to create linked tables, based on a list of named ranges that I have in Excel so that all the named ranges will be converted to tables in Access. Formatting is not an issue as I know the format of the ranges that are named are OK to be used as tables in Access.
Is there a way to easily do this?

INSERT INTO appends to existing tables, SELECT .... INTO creates new ones.
If you want to rewrite that query to a SELECT INTO, it would be as simple as this:
ssql = "SELECT * INTO Table1 "
ssql = ssql & "FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
Note that you first need to delete the table if you want to overwrite it.
Your question has several subquestions. I can get into creating links in ADO on specific columns, but you haven't shown an attempt, nor have you shared enough information to write an applicable answer.

A sample to elaborate on the TransferSpreadsheet method :
Dim sNT as String, sWB as String, sRN as String sNT = "Table1" sWB = "C:\MyWorkBook.xls" sRN = "namedrange1" DoCmd.TransferSpreadSheet acLink, , sNT, sWB, True, sRN
This has to be run in a module in ms-access.

Related

Export Excel table to MS Access table (without duplicating data on subsequent runs)

I would like to transfer my Excel table directly to MS Access with VBA.
This solution
Using Excel VBA to export data to MS Access table only adds the range of data.
Is it possible to export Excel table to MS Access table directly?
Every time I run this code, it duplicates the data. I can't edit the sCommand into Update statement it gives me an error.
Sub test()
dbWb = Application.ActiveWorkbook.FullName
dsh = "[" & Application.ActiveSheet.Name & "$]" & "Data2" 'Data2 is a named range
sdbpath = "C:\Users\myname\Desktop\Database2.mdb"
sCommand = "INSERT INTO [main] ([dte], [test1], [values], [values2]) SELECT [haha],[test1],[values],[values2] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
Dim dbCon As New ADODB.Connection
Dim dbCommand As New ADODB.Command
dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbpath & "; Jet OLEDB:Database Password=;"
dbCommand.ActiveConnection = dbCon
dbCommand.CommandText = sCommand
dbCommand.Execute
dbCon.Close
End Sub

Export Named Table from Excel to Access

OK. I'm sorry for wasting everyone's time. Like a DUMMY i didn't think simple solution first. The amount of data i am dealing with isn't too large and will actually work better just exporting to an excel file (i'm pretty sure). I would like to thank all that helped (June7, Parfait, and HansUp). The support you guys (everyone on this forum) give has made my job easier by far.
I'm trying to export an Excel Table from my active excel file to an Access database file.
I was getting an error at
"con.excecute sql"
"Run-time error '-2147467259 (80004005)': [Microsoft][ODBC Microsoft Access Driver] Query input must contain at least one table or query."
Sub updateAccess()
Dim con As New ADODB.Connection
Dim connectionString As String
Dim sql, newTable As String
Filename = "C:\Desktop\Quote-Size_Contacts.accdb"
connectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=" & Filename
con.Open connectionString
' Save current table ("ContactsTbl_Data") to another table ("ContactsTbl_Data_yyyymmdd_hh_mmss")
newTable = "Quote-Size_Contacts_" & Format(Date, "yyyymmdd") & "_" & Format(Now, "hhmmss")
sql = "SELECT CODE, STORE INTO " & newTable & "FROM ContactsTbl_Data"
con.Execute sql
' Delete rows of current table ("ContactsTbl_Data")
sql = "DELETE FROM ContactsTbl_Data"
con.Execute sql
' Insert new rows into current table ("ContactsTbl_Data") from my Excel Sheet
sql = "INSERT INTO ContactsTbl_Data ([CODE], [STORE]) " & _
"SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & ThisWorkbook.FullName & "].[" & ThisWorkbook.Sheets("Sheet2").Name & "$]"
con.Execute sql
con.Close
Set con = Nothing
End Sub
EDIT::
I'm not sure standard protocol for these forums on cleaning up the code and asking more questions so i'll just put an "Edit" here.
I applied the suggestions and matched the fields it was trying to save to my access file. I now get the error: "Method 'Execute' of object '_Connection' failed"
Public Sub updateAccess()
Dim con As New ADODB.Connection
Dim connectionString As String
Dim sql, newTable As String
Filename = "C:\Desktop\Quote-Size_Contacts.accdb"
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='" & Filename & "'"
con.Open connectionString
' Save current table ("ContactsTbl_Data") to another table ("ContactsTbl_Data_yyyymmdd_hh_mmss")
newTable = "Quote-Size_Contacts_" & Format(Date, "yyyymmdd") & "_" & Format(Now, "hhmmss")
sql = "SELECT Company, Contact, Initials, Position, Address, AddressContd, CityStatePost, MainNo, CellNo, FaxNo, Email INTO [" & newTable & "] FROM ContactsTbl_Data"
con.Execute sql
' Delete rows of current table ("ContactsTbl_Data")
sql = "DELETE FROM ContactsTbl_Data"
con.Execute sql
' Insert new rows into current table ("ContactsTbl_Data") from my Excel Sheet
sql = "INSERT INTO ContactsTbl_Data ([Company], [Contact], [Initials], [Position], [Address], [AddressContd], [CityStatePost], [MainNo], [CellNo], [FaxNo], [Email]) " & _
"SELECT * FROM [Excel 12.0 Xml;HDR=Yes;Database=" & ThisWorkbook.FullName & "].[" & ThisWorkbook.Sheets("Sheet2").Name & "$]"
con.Execute sql
con.Close
Set con = Nothing
End Sub
See if this helps.
Table name has hyphen (-) character so use [ ] characters to delimit. Add a space in front of FROM so text doesn't run together in compiled SQL string.
sql = "SELECT CODE, STORE INTO [" & newTable & "] FROM ContactsTbl_Data"
As for connection to Access database, don't think I've ever used or seen Driver, I use Provider:
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='" & Filename & "'"

How to merge two tables from two different work sheets into one final table with different columns?

I am very new to coding (a newbie).
At work place, I have following to do:
A) I have Table A
B) I have Table B
C) I need output Table C (how do I get it?)
I am describing in details here:
Input Tables A and B:
Output Table C:
I have to get Output table C for many many files and thus will be very difficult to match up Order and Order-1 in the Tables using copy and past option in excel.
Thanks a ton for looking into this.
Apologies if the question is not clear.
Please let me know if you need any further information regarding this.
You can try taking a UNION of the two tables:
SELECT Time, Type, User, '', Order-1, Urea
FROM TableA
UNION ALL
SELECT Time, '', User, Order, Order-1, Urea
FROM TableB
ORDER BY Time
If you're not really using MySQL, then you should not have tagged your question as such, which generated an answer like this one.
this is Vba of SQL. practice sub myQuery.
Dim Ws As Worksheet
Dim strSQL As String
Sub myQuery()
Set Ws = Sheets("C")
strSQL = "SELECT Time, Type, User, '' as [Order], [Order-1], Urea"
strSQL = strSQL & " FROM [A$] where not isnull(Time) "
strSQL = strSQL & " Union All "
strSQL = strSQL & "SELECT Time, '', User, [Order], [Order-1], Urea "
strSQL = strSQL & "FROM [B$] where not isnull(time) "
strSQL = strSQL & "ORDER BY Time "
DoSQL
End Sub
Sub DoSQL()
Dim Rs As Object
Dim strConn As String
Dim i As Integer
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 12.0;"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open strSQL, strConn
If Not Rs.EOF Then
With Ws
.Range("a1").CurrentRegion.Clear
For i = 0 To Rs.Fields.Count - 1
.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next
.Range("a" & 2).CopyFromRecordset Rs
.Columns(1).NumberFormatLocal = "[$-409]mm/dd/yy h:mm AM/PM;#"
End With
End If
Rs.Close
Set Rs = Nothing
End Sub

How do I insert into an Office 365 Access database using Excel VBA

I've recently upgraded to office 365 and now find myself attempting to use excel VBA to insert from an Excel sheet into an Access database. Here is the VBA code I'm trying to use:
Sub ExportDataToAccess()
Dim cn As Object
Dim strQuery As String
Dim myDB As String
Dim creditDate As Date
Dim regionalTeam As String
'Initialize Variables
creditDate = Worksheets("Treasury").Range("E20").Value
regionalTeam = Worksheets("Treasury").Range("e21").Value
myDB = "Y:\Credit DB\Credit.accdb"
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0" 'For *.ACCDB Databases
.ConnectionString = myDB
.Open
End With
strQuery = "INSERT INTO Credit ([creditDate], [regionalTeam]) " & "VALUES (""" & creditDate & """, " & regionalTeam & ");"
cn.Execute strQuery
cn.Close
Set cn = Nothing
End Sub
When I run this subroutine, I get the following error message:
Runtime error: No value given for one or more required parameter.
I've tried to Google the error message but didn't have much luck. Can anyone tell me where I have gone astray? I've also confirmed that creditDate and regionalTeam have valid values. I should add that the cn.Execute strQuery seems to be the offending code (highlighted).
Thanks for your input.
Format your date expression:
strQuery = "INSERT INTO Credit ([creditDate], [regionalTeam]) VALUES (#" & Format(creditDate, "yyyy\/mm\/dd") & "#, " & regionalTeam & ");"
or, if the team is text:
strQuery = "INSERT INTO Credit ([creditDate], [regionalTeam]) VALUES (#" & Format(creditDate, "yyyy\/mm\/dd") & "#, '" & regionalTeam & "');"

Get end of rows of an excel file within access vba

I'm importing an excel file into access using vba (dao) in the following manner:
Set db = CurrentDb
query = "SELECT DISTINCT * INTO MyTable" _
& " FROM [Excel 12.0 Xml;HDR=Yes;Database=" & filePath & "].[Sheet1$];"
db.Execute (query)
[Sheet1$] is the keyword here. My excel table header starts with line 3. I want to do something like [Sheet1$A3:Lastline].
Is there a simple way to obtain the lastline? Or do I really need to create a VBA Excel Object, open the file and count?
Alternatively, can I change the header start? For instance, by using a custom import scheme instead?
Thanks in advance.
Consider a count query using a recordset and concatenate result in make-table query:
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim query As String
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT Count(*) AS RowCount" _
& " FROM [Excel 12.0 Xml;HDR=No;Database=" & filePath & "].[Sheet1$]")
query = "SELECT DISTINCT * INTO MyTable" _
& " FROM [Excel 12.0 Xml;HDR=Yes;" _
& " Database=" & filePath & "].[Sheet1$A3:A" & rst!RowCount & "];"
db.Execute (query)
rst.Close
Set rst= Nothing
Set db = Nothing

Resources