Using ADO VBA to Insert Excel Fields into Access Table - excel

I am trying to use ADO to access and read some things from an Excel File. I understand how to get it open and do the SELECT * and put that into a Recordset Object. What I don't understand is if I am select a group of info, how to access specific fields in that Recordset.
Code:
Private Sub SaveReq_Click()
'
' Saves the current entry to the database
' Into the TABLE 'pr_req_table'
'
' Open a connection to the database
dim data_base as Database
set data_base = OpenDatabase(CurrentProject.Path & "\test_database.accdb")
Sub InsertRecord()
Dim data_base As Database
Set data_base = OpenDatabase(CurrentProject.Path & "\test_database.accdb")
' Grab all information from form
' Add information to pr_req_table
Dim qd As QueryDef
Set qd = data_base.CreateQueryDef("")
qd.sql = "INSERT INTO pr_req_table(pr_no, pr_date, pr_owner, pr_link, pr_signed) " & _
"values([p1],[p2],[p3],[p4],[p5])"
qd.Parameters("p1").Value = pr_num.Value
qd.Parameters("p2").Value = Format(pr_date.Value, "mm/dd/yyyy")
qd.Parameters("p3").Value = List22.Value
qd.Parameters("p4").Value = "Excel Copy #" & elec_copy.Value
qd.Parameters("p5").Value = "Signed Copy #" & sign_copy.Value
qd.Execute
' The following section reads from the elec_copy field's hyperlink
' It scans the Excel file for items it needs to include into the table
' It enters those cells into the TABLE 'items_needed_table'
'
' Slects row by row, and if the item has been marked TRUE, inserts
' That row into the TABLE 'items_needed_table'
' Open a connection to Excel
On Error Resume Next
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & elec_copy.Value & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"
' Decalre a RecordSet Object
Set objRecordSet = CreateObject("ADODB.Recordset")
' Grab all Rows in the Plain_VDR Sheet where 'needed' column == TRUE
objRecordset.Open "Select line_no, desc, weeks FROM [Plain_VDR$] Where needed = TRUE", _
objConnection, adOpenStatic, adLockOptimistic, adCmdText
' Declare a loop counter for row?
Dim x as Integer
x = 0
' Write the information pulled, into the TABLE 'items_needed_table' in Access Database
Do Until objRecordset.EOF
qd.sql = "INSERT INTO items_needed_table(pr_no, line_no, desc, weeks) " & _
"Values([p1],[p2],[p3])"
' p1 was declared earlier in code, same value as before
qd.Parameters("p2").Value = objRecorset.(ROW_X, "line_no")
qd.Parameters("p3").Value = objRecordset.(ROW_X, "desc")
qd.Parameters("p4").Value = objRecordset.(ROW_X, "weeks")
qd.Execute
x = x + 1
Loop
' Close Database connection
data_base.Close
End Sub
My main point of concern is the 'Do Until' loop section. Doubtful I can insert the entire selection, because 'pr_no' is not defined in the Excel file, but back in Access Database, so I think I will need to loop that command for each row in the Excel file.
What do I need to use to assign my parameters the values, per row and field, from the Recordset Object?
Thanks in advance for any help!
Nathan

In your connection string, you have said HDR=Yes, which means that the first row of your range contains the names of your fields, so, very roughly:
Do Until objRecordset.EOF
qd.Sql = "INSERT INTO items_needed_table(pr_no, line_no, desc, weeks) " & _
"Values([p1],[p2],[p3])"
' p1 was declared earlier in code, same value as before
'**No it was not, the earlier stuff is mostly irrelevant
qd.Parameters("p2").Value = objRecorset.Fields("line_no")
qd.Parameters("p3").Value = objRecordset.Fields("desc")
qd.Parameters("p4").Value = objRecordset.Fields("weeks")
qd.Execute
''You are moving through a recordset, not a worksheet
objRecordset.MoveNext
Loop
If this all that you are doing with the selection from Excel, it could be inserted with one query, because you are not changing pr_num.

Related

Execute sql complex query through excel vba

Just to give you background of my work, i have to fetch data from MS Sql on daily basis and for that every time have to go to other server to run the query. Once the query is executed, have to paste into my common drive, which takes a lot time. ~55 mins to paste 5,00,000 row & 30 fields to common or to move file. In total 2 hours for execution & movement from one location to other.
To reduce this i would need your help to use the SQL queries through excel with the below things:
If possible,
Point1: Query will be stored in the text file in the common location
Point2: Query Parameter to be populate to get
Or
Point2:Range to be defined for parameter
If not possible above,
Query will be pasted into the code and parameter to be populated based on the above mentioned suggestion.
Connection type is windows authentication, it will work based on logged in users windows name.
This code will allow you to provide variables that you use within your SQL statement and put those into cells on a spreadsheet (In this case Cred2) and return the results on a separate sheet (Sheet2).
The first portion of the code establishes a connection with the SQL server.
The column Headers will be started in Row 2 and then the data will begin populating starting on row 3. I have used this to pull well over 100,000 records at a time and this works very quickly.
Private Sub CommandButton1_Click()
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL As String
strCon = "DRIVER=SQL Server;SERVER=ServerName;DATABASE=DBName;Trusted_Connection=True"
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
' if not a trusted connection you could replace top line of strCon with
strCon = "DRIVER=SQL Server; Server=myServerAddress;Database=myDataBase;User Id=myUsername; Password=myPassword"
' set up where you are getting your variables to include in the SQL statement
stat = Sheets("Cred2").Range("c7").Value
barg = Sheets("Cred2").Range("c10").Value
worksite = Sheets("Cred2").Range("c11").Value
' Construct SQL statement
strSQL = "select * " _
& " FROM tableName A , table2 B " _
& "WHERE A.[field1] = B.[field1] " _
& " and field1 like '" & stat & "'" _
& "and field2 like '" & barg & "'" _
& "and field3 like '" & worksite & "'" _
& " order by Field? "
' Build Record Set
Set rs = CreateObject("ADODB.RECORDSET")
rs.ActiveConnection = cn
rs.Open strSQL
' Display Data
For intColIndex = 0 To rs.Fields.Count - 1
Sheet2.Range("A2").Offset(0, intColIndex).Value = rs.Fields(intColIndex).name
Next
Sheet2.Range("A3").CopyFromRecordset rs
' Close Database
rs.Close
cn.Close
Set cn = Nothing
end sub

How to transfer an excel spreadsheet to an access database

I'm making a program to track my weight, calories I eat in a day, and the date, to help me lose weight. I'm manually putting in these values into a spreadsheet with those three columns (date, calories, weight). I want to transfer the information in these three columns into an access database.
Code so far:
Sub transferdata()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
connStr = "C:\Users\sachu\Desktop\Assignment 5\CalorieDatabase.mdb"
providerStr = "Microsoft.ACE.OLEDB.12.0"
With cn
.ConnectionString = connStr
.Provider = providerStr
.Open
End With
rs.Open sqlStr, cn
rs.Close
cn.Close
End Sub
So far my code is only starting the connection between access and excel
There are many ways to do this. Let's look at a couple of case studies.
Export data from Excel to Access (ADO)
If you want to export data to an Access table from an Excel worksheet, the macro example below shows how this can be done.
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\FolderName\DataBaseName.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Also . . .
Export data from Excel to Access (DAO)
If you want to export data to an Access table from an Excel worksheet, the macro example below illustrates another way to do this.
Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb")
' open the database
Set rs = db.OpenRecordset("TableName", dbOpenTable)
' get all records in a table
r = 3 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("FieldName1") = Range("A" & r).Value
.Fields("FieldName2") = Range("B" & r).Value
.Fields("FieldNameN") = Range("C" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
Also . . .
Browse to a single EXCEL File and Import Data from that EXCEL File via TransferSpreadsheet (VBA)
Here's yet another way . . .
Sub TryThis()
Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter As String, strInitialDirectory As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False
strBrowseMsg = "Select the EXCEL file:"
' Change C:\MyFolder\ to the path for the folder where the Browse
' window is to start (the initial directory). If you want to start in
' ACCESS' default folder, delete C:\MyFolder\ from the code line,
' leaving an empty string as the value being set as the initial
' directory
strInitialDirectory = "C:\MyFolder\"
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
Filter:=strFilter, OpenFile:=False, _
DialogTitle:=strBrowseMsg, _
Flags:=ahtOFN_HIDEREADONLY)
If strPathFile = "" Then
MsgBox "No file was selected.", vbOK, "No Selection"
Exit Sub
End If
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tablename"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
End Sub
I know this looks like a dead thread but I wanted to revive for Office 360 users. I had to compile an answer from several sources to make something workable. See below.
First- note that you need at least the 2 following references active in your Tools>References Menu.
Microsoft Access 16.0 Object Library &
Microsoft Office 16.0 Access Database Engine Object
You may also need to have:
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
Sub rtnExporttoAccess()
Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
Dim oSelect As Range, sPath As String, sRecordSet As String
Set sheet = ActiveWorkbook.Worksheets("YourSheet") 'excel sheet
Set table = sheet.ListObjects.Item("YourTable") 'excel table
Set oSelect = table.ListRows(table.ListRows.Count).Range 'set your sheet and range however you want
sPath = "your database file path"
sRecordSet = "the title of the table in that database" 'access table
Set oDAO = New DAO.DBEngine
Set oDB = oDAO.OpenDatabase(sPath)
Set oRS = oDB.OpenRecordset(sRecordSet)
oRSct = oRS.Fields.Count
xclFieldCt = table.ListColumns.Count
If oRSct > xclFieldCt Then
intTargetCt = oRSct
Else
intTargetCt = xclFieldCt
End If
For i = 2 To oSelect.Rows.Count
oRS.AddNew
'finds the correct fields to add data to
For j = 0 To intTargetCt - 1 'access is base 0 so the end is always -1
oRSHeaderName = oRS.Fields(j).Name 'gets database table variable header name
For col = 1 To intTargetCt 'excel is base 1
lastRowHeaderName = table.HeaderRowRange(1, col) ' gets excel table variable header name
If oRSHeaderName = lastRowHeaderName Then 'this verifies both headers are the same
oRS.Fields(j) = Now
Exit For
End If
If oRSHeaderName = "Pass/Failed" And lastRowHeaderName = "Pass/Failed" Then 'this verifies the you are putting the data where you want it if headers arent the same.
oRS.Fields(j) = cbxPF
Exit For
End If
Next col
Next j
oRS.Update
Next i
oDB.Close
End Sub
ASH's second DAO option is basically what this code is as well. I included the references and gave some extra options for you to see some more examples.
Creat a stand alone Acces DB then link the Excel in it. The Access has tools to import data from Excel with live communication.
Follow this:
Open MS Access
Creat new blank database (in this step you have to give name to the database, and set the save location)
In the new database on External Data tab choose the correct type to add based on what you want to import (in this case you have to select Excel)
in the earlier MS Access version the popular insertable things were stretched
in the 2016 version, and O365 the options is more compact so there is one option called New Data Source which contain all possibilities
The import progress consits of several steps.
you have to select the source and set how you want to import data. You can import data into a new table in Access as a copy, or you can connect the source of data to the Access database. Select connect source data for live communication.
select inner data source (for example which sheet, or range you want to import)
set if the first row contain headers
give a name to the linked table
Finally data from Excel linked into Access and it will update when you use it.

Using ADODB to write to Excel file

I hope someone can give me some direction using the ADODB methods to accomplish my goal.
Brief explanation:
Currently I have code in Outlook VBA that searches an email. If the email passes criteria the Outlook macro opens an Excel workbook, loops through column A to see if an ID number exists. If it does it updates other columns (1 or more columns), if not it creates a new row and writes data into Columns A-C for that row. Then saves and closes the workbook.
I want to speed up the process and the limiting factor is opening the excel workbook (located on a share drive). I have used a simple ADODB macro to read data in another workbook and have seen the speed increases possible. I want to implement that here.
I have been able to establish connection to the workbook from Outlook and place data into a recordset. BUT I don't know how to "loop" through the first column to see if the ID exists yet or not, and further more how to write data into the columns in the workbook (UPDATE SQL command?).
ExcelConnection Code:
Public Sub ExcelConnect(msg As Outlook.MailItem, LType As String)
Dim lngrow As Long
Dim SourceFile As Variant 'used
Dim SourceSheet As String 'used
Dim SourceRange As String 'used
SourceFile = "T:\Capstone Proj\TimeStampsOnlyTest.xlsx"
SourceSheet = "Timestamps"
SourceRange = "A2:F500"
Dim rsCon As Object 'used
Dim rsData As Object 'used
Dim szConnect As String ' used
Dim szSQL As String ' used
Dim lCount As Long
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1
'***Need Help implementing a way to find exisiting ID numbers, or if Exisiting = 0 then INSERT new row into worksheet***'
Select Case LType '// Choose which columns based on Type
Case "MDIQE"
' If columnvalue = 0 Then
' Update column value
Case "MDIQ"
' If columnvalue = 0 Then
' Update column value
'
'........
'
Case "MDIF"
' If columnvalue = 0 Then
' Update column value
'
End Select
'Error handing & success messagebox
End sub
Thank you for the help,
Wagner
In your SELECT statement, include a WHERE clause to search for the ID in column A, something like this:
SELECT COUNT(*) c
FROM [sourceSheet$sourceRange]
WHERE <ColumnAName> = <ID>
note, this is pseudocode, you'll have to properly assemble the statement just like you did when you assigned a string to szSQL
Then check your result set for the value of c, something like this:
If rsData.Fields("c").value = 0 Then
'ID was NOT found, execute SQL INSERT here
Else
'ID was found, execute SQL UPDATE here
End If
i.e., treat your Excel worksheet like a database.
Of course, it would be better if you could use Access as a database (or SQL Server, or Oracle, or ...) since, well, that's what they're designed to do. But I understand that sometimes you've just got to roll with what you've got.

How to use a loop to fill in multiple controls on a Userform?

I have the following code that looks up an ID in a data table and returns the corresponding value from other columns. Below is the code to return a single column value and post it to the TextBox/ComboBox on my form. However, I am looking to create this as a loop to post to all the 20-30 fields I have rather than repeating the code for each field.
col_no = 3 to 29
Note that my TextBox/ComboBox have varying names e.g. customer, site etc.
id_1 = OrderDisplay.id
col_no = 3
sales_order = WorksheetFunction.VLookup(id_1, Worksheets("Data").Range("A:AB"), col_no, False)
OrderDisplay.sales_order = sales_order
How can I achieve that?
Consider querying your worksheet data as a database as it seems to be tabular structure where you pass in as a parameter the specific id. In fact, this may set you up to upsize your worksheet to actual database like MS Access (Excel's sibling), SQLite, etc. where you can swap out the ADO connection string and then sheet name in SQL for database table!
Below assumes all your userform controls have the same exact name as table fields (first columns of worksheet).
Dim conn As Object, rst As Object, cmd As Object
Dim strSQL As String, id1 As Long
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Path\To\Workbook.xlsm';" _
& "Extended Properties=""Excel 12.0;HDR=YES;"";"
' OPEN CONNECTION
conn.Open strConnection
' WORKBOOK QUERY
strSQL = "SELECT t.* " _
& " FROM [SheetName$] AS t" _
& " WHERE t.id = ?"
id_1 = OrderDisplay.id
' BUILD PARAMETERED QUERY
Set cmd = CreateObject("ADODB.Command")
With cmd
.ActiveConnection = conn
.CommandText = strSQL
.CommandType = adCmdText
.Parameters.Append .CreateParameter("idparam", adInteger, adParamInput, , id1)
End With
' CREATE RECORDSET
Set rst = cmd.Execute
' LOOP THROUGH RECORDSET AND FILL IN CONTROL VALUES
rst.MoveFirst
Do While Not rst.EOF
For i = 1 To rst.Fields.Count - 1
Me.Controls(rst.Fields(i).Name).Value = rst.Fields(i)
Next i
rst.MoveNext
Loop
rst.Close: conn.Close
Set conn = Nothing: Set rst = Nothing: Set cmd = Nothing

how to read data from excel sheet and store it into a user defined variable

I have created a code to modify a date by adding specific no of days into it by using a variable name Date.
Now i am having several texts including several different dates in excel sheet which i want to read then modify and again rewrite into same excel sheet.
For this i have created a code but i am not able to load the data read from excel sheet to a variable.
please suggest and provide a code/query how to read data from excel sheet and store it into a user defined variable
Try this example
values are stored in rowData variable
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("D:\VBScriptTrainee\Teams.xlsx")
objExcel.visible=True
rowCount=objExcel.ActiveWorkbook.Sheets(1).UsedRange.Rows.count
colCount=objExcel.ActiveWorkbook.Sheets(1).UsedRange.Columns.count
Msgbox("Number of Rows are " & rowCount)
Msgbox("Number of columns are " & colCount)
intRow = 1
intCol = 1
rowData=null
for intRow=1 to rowCount step 1
for intCol=1 to colCount step 1
rowData = rowData & " " & objExcel.Cells(intRow, intCol).Value
next
rowData = rowData & vbnewline
next
Msgbox(rowData)
objExcel.Quit
set objExcel=nothing
If you have dates in excel in the single column with column name as
're-data'. We can take out sample code using ADO connection string. Here is the sample VBS code.
filelocation = "D:\New Microsoft Excel Worksheet.xlsx"
SheetName = "Sheet1"
column_name = "re_data"
row_number = 8
'Create connection
Set conn = CreateObject("ADODB.Connection")
'Create Record Set
Set recordset = CreateObject("ADODB.Recordset")
'Connection String
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filelocation & ";Extended Properties = Excel 12.0 Macro;"
On Error Resume Next
'Connection Open
conn.Open
query = "SELECT * FROM " & "[" & SheetName & "$] "
recordset.Open query, conn, 3, 3
Count = 1
Do Until recordset.EOF Or Count = row_number
Output_variable = recordset.Fields.Item(column_name).Value
recordset.MoveNext
Count = Count + 1
Loop
MsgBox Output_variable
recordset.Close
conn.Close

Resources