I know there is DoCmd.TransferSpreadsheet acExport, but this requires a hard query name.
I am trying to loop over a recordset and exporting a file per view, so for example exporting an Excel file for "select * from myQuery where arguments=arg1", another file for "select * from myQuery where arguments=arg2", and so on.
Is there a way to create such an Excel file based on "custom" on the fly SQL query like this?
Use CopyFromRecordset which essentially dumps VBA recordsets to Excel worksheet range (referencing only the the upper left corner cell). Below is a subroutine using Access VBA:
Public Sub acToxlRecordsets()
Dim xlApp As Object, xlwkb As Object
Dim db As Database
Dim rst As Recordset
Dim args As Collection, arg As Variant
Dim strPath As String, strSQL As String
Dim i As Integer
Dim fld As Field
' INITIALIZE OBJECTS
Set db = CurrentDb()
Set xlApp = CreateObject("Excel.Application")
args.Add ("arg1")
args.Add ("arg2")
args.Add ("arg3")
strPath = "C:\Path\To\Excel\Files"
i = 1
For Each arg In args
' CREATE NEW WORKBOOK
Set xlwkb = xlApp.Workbooks.Open(strPath & "\ExcelFile" & i)
' OPEN NEW RECORDSET
strSQL = "select * from myQuery where arguments = " & arg
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
rst.MoveFirst
' OUTPUT RECORDSET
' FIRST COLUMNS
xlwkb.Worksheets(1).Activate
xlwkb.Worksheets(1).Range("A1").Select
For Each fld In rst.Fields
xlApp.ActiveCell = fld.Name
xlApp.ActiveCell.Offset(0, 1).Select
Next
' NEXT ROWS
xlwkb.Worksheets(1).Range("A2").CopyFromRecordset rst
xlwkb.Worksheets(1).Range("A1").Select
' SAVE AND CLOSE EXCEL WORKBOOK
xlwkb.Close True
i = i + 1
Next arg
' UNINITIALIZE OBJECTS
rst.Close
Set xlwkb = Nothing
Set xlApp = Nothing
Set rst = Nothing
Set db = Nothing
End Sub
Related
I am working on a project where I'm using SQL to return records from a database into a listbox using userinput. Things are fine when there's more than one result, the listbox reads properly. However, when there's only one record, it doesn't transpose it like it does with all the others. Multiple Returns Single Return
I've tried to do an "if employeeoutput.recordcount = 1 then don't transpose" type of thing, but that still sends me with the Single Return.
Private Sub cmdSearch_Click()
Stop
'connect to database
'make dynamic code
'profit
'set up DB and Recordset
Dim calldbconn As ADODB.Connection
Dim EmployeeOutput As ADODB.Recordset
Dim EmpData As Variant
'its a special tool we're going to use later
Dim InContactInput As String
Dim FNameInput As String
Dim LNameInput As String
Dim TeamNameInput As String
Dim TeamNumberInput As Integer
Dim SQLString As String
'set it up for a new recordset
Set calldbconn = New ADODB.Connection
Set EmployeeOutput = New ADODB.Recordset
'set the vars
InContactInput = txtInContactNum.Value
FNameInput = txtFirstName.Value
LNameInput = txtLastName.Value
TeamNameInput = cboTeamName.Value
TeamNumberInput = cboTeamName.ListIndex + 1
'---------A bunch of stuff here to build the SQL String----------
'----------------------------------------------------------------
'Time to connect
calldbconn.ConnectionString = StrCallDB
calldbconn.Open
On Error GoTo CloseConnection
With EmployeeOutput
.ActiveConnection = calldbconn
.Source = SQLString
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
EmpData = .GetRows
On Error GoTo CloseRecordset
End With
'And now, the list box
With lstResults
.Clear
.List = Application.Transpose(EmpData)
End With
'close and reset
CloseRecordset:
EmployeeOutput.Close
CloseConnection:
calldbconn.Close
Set EmployeeOutput = Nothing
Set calldbconn = Nothing
End Sub
Hi Im making a Excel Form in which my Database is an access.
First I Encode data in Excel then Using Command Button to Post these data.
The code within the Command Button.. first get the Max Number from Access and use that Number to Complete the Data in Excel to be exported to Access. The Problem is If I use 2 and above users to simultaneously Post it will consolidate all the data into one with the same Number.
What I want is to lock opening data until posted since i need to get the max number of a column then add 1 first then import a complete set of data including the MAX number as a control number.
I tried using Do While adStateOpen <> 1 and also Do While IsRecordBusy = True then wait and loop and set the recordset to nothing instead of closing it twice. But it wont work it will consolidate the data with the same control number.
Below is my Code
Option Explicit
Sub ImportJEData()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath
Dim x As Long, i As Long
Dim nextrow As Long
Dim Var
Dim LockType
Dim SQL
Dim IsRecordBusy
'add error handling
On Error GoTo errHandler:
'Variables for file path and last row of data
dbPath = Sheets("Update Version").Range("b1").Value
Set Var = Sheets("JE FORM").Range("F14")
nextrow = Sheets("LEDGERTEMPFORM").Cells(Rows.Count - 5, 1).End(xlUp).Row
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Create the ADODB recordset object. for Max Number
Set rst = New ADODB.Recordset 'assign memory to the recordset
LockType = adLockPessimistic
'Do While adStateOpen <> 1
Do While IsRecordBusy = True
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Loop
SQL = "SELECT distinct Max(DVNumber),Max(ChckID) FROM DV "
rst.Open SQL, cnn
Sheets("Max").Range("A2").CopyFromRecordset rst
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.Open Source:="DV", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockPessimistic, _
Options:=adCmdTable
On Error Resume Next
'you now have the recordset object
'add the values to it
For x = 7 To nextrow
rst.AddNew
For i = 1 To 37
rst(Sheets("LEDGERTEMPFORM").Cells(6, i).Value) = Sheets("LEDGERTEMPFORM").Cells(x, i).Value
Next i
rst.Update
Next x
'close the recordset
rst.Close
' Close the connection
cnn.Close
'clear memory
Set rst = Nothing
Set cnn = Nothing
'Update the sheet
Application.ScreenUpdating = True
'Clear the data
On Error GoTo 0
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub
Im finally done with this code. I just added another Table in access where such table is unique the uses sql to get the max+1 and insert it back and loop it if error occurs because of the duplicate. Heres the code below
Do
On Error Resume Next 'reset Err.obj.
'Get the Max ID +1
Set rst = Nothing
Set rst = New ADODB.Recordset 'assign memory to the recordset
SQL = "SELECT Max(ApNumber)+1 FROM PayVoucherID "
rst.Open SQL, cnn
'Check if the recordset is empty.
'Copy Recordset to the Temporary Cell
Sheets("MAX").Range("A2").CopyFromRecordset rst
'Insert the Data to Database And Check If no Errors
Sql2 = "INSERT INTO PayVoucherID(ApNumber)Values('" & Sheets("MAX").Range("A2") & "') "
cnn.Execute Sql2
Loop Until (Err.Number = 0)
Hope this helps for Excel Front users.
I have been performing these operations through excel, but the raw data that I am dealing with is overwhelming for excel. I shifted over to access as the database but I am trying to find similar functionality. I am still using excel as my interface.
I am essintially breaking my data into samples. Taking a sample of the data, analyzing it then moving on to the next sample. I would like to do the same with the Access data. What I am looking for is how to perform operations (summation, multipication, division,max, min...) on a sample using a for loop. Also, what is the ID of max value and ID on the min value. I am also dealing with a huge amout of raw data, so the less lines of code would be optimal. Any pointers in the right direction would be appreciated.
Code in Excel:
For CoUnTer = 1 To FindRecordCount
Set Circ_Rng = WS.Range(WS.Cells(CoUnTer , 5), WS.Cells(CoUnTer + TempTimeFrame - 1, 5))
Set DataPoint_Rng = WS.Range(WS.Cells(CoUnTer , 1), WS.Cells(CoUnTer + TempTimeFrame - 1, 1))
Set DataPoint_Circ_Rng = WS.Range(WS.Cells(CoUnTer , 8), WS.Cells(CoUnTer + TempTimeFrame - 1, 8))
Set DataPoint_SQ_Rng = WS.Range(WS.Cells(CoUnTer , 9), WS.Cells(CoUnTer + TempTimeFrame - 1, 9))
'---------------------------
MaxPoint = WorksheetFunction.Max(CircPressure_Rng)
Row_At_MaxPressure = WS.Columns(5).Cells.Find(MaxPoint, After:=WS.Cells(3, 5), SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlNext).Row
Sigma_X_Sigma_Y = WorksheetFunction.Sum(Circ_Rng) * WorksheetFunction.Sum(DataPoint_Rng)
Sigma_XY = WorksheetFunction.Sum(DataPoint_Circ_Rng)
Sigma_X2 = WorksheetFunction.Sum(DataPoint_SQ_Rng)
Min_X = WorksheetFunction.Min(DataPoint_Rng)
Code for Access data:
This code gets the data sample. What I am missing how can I handle the operations on them similar to what I have done in excel.
Sub GetAccessData()
Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Long
Dim x As Long
Application.ScreenUpdating = False
'DataBase Path
DBFullName = WB_Path & "\RawData - Template.accdb"
'Open the Connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
'Create a RecordSet
Set Recordset = New ADODB.Recordset
' Client-side cursor
Recordset.CursorLocation = adUseClient
With Recordset
Source = "SELECT * FROM RawData WHERE [ID] BETWEEN " & StartofData & " AND " & EndofData
.Open Source:=Source, ActiveConnection:=Connection
On Error Resume Next
End With
EndofData = Recordset.RecordCount
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
'Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub
As you are seeing, Excel is better for some things and Access is better for some things. Sometimes you can literally substitute Access for Excel, and vice versa, but often each one should be used for it's intended purpose. There are probably a few ways forward here, but I would lean towards leaving your Excel stuff in Excel, and control Excel from Access. You can use Late Binding or Early Binding to control one app from another app. Here are two options for you to consider.
‘EARLY BINDING
Option Compare Database
Option Explicit ' Use this to make sure your variables are defined
' One way to be able to use these objects throughout the Module is to Declare them
' Here and not in a Sub
Private objExcel As Excel.Application
Private xlWB As Excel.Workbook
Private xlWS As Excel.Worksheet
Sub Rep()
Dim strFile As String
strFile = "C:\your_path_here\YourExcelFile.xls"
' Opens Excel and makes it Visible
Set objExcel = New Excel.Application
objExcel.Visible = True
'Opens up the Workbook
Set xlWB = objExcel.Workbooks.Open(strFile)
'Sets the Workseet to the last active sheet - Better to use the commented version and use the name of the sheet.
Set xlWS = xlWB.ActiveSheet
'Set xlWS = xlWB("Sheet2")
With xlWS ' You are now working with the Named file and the named worksheet
End With
'Do Close and Cleanup
End Sub
‘LATE BINDING
Sub ControlExcelFromAccess()
' No reference to a type library is needed to use late binding.
' As long as the object supports IDispatch, the method can
' be dynamically located and invoked at run-time.
' Declare the object as a late-bound object
Dim oExcel As Object
Dim strFile As String
strFile = "C:\your_path_here\YourExcelFile.xls"
Set oExcel = CreateObject("Excel.Application")
' The Visible property is called via IDispatch
oExcel.Visible = True
Set xlWB = oExcel.Workbooks.Open(strFile)
'Call code here . . .
Set oExcel = Nothing
End Sub
Just copy/paste your code inside this code, make a few small tweaks if necessary, and you should be good to go!
I've Searched Forums here and I can't seem to get this code to work.
I am Trying to Open a Workbook in Excel, and then populate a few of the Cells(Named Ranges). I can successfully open the workbook(the workbook has a bit of VBA that runs when it opens as well, formatting stuff only) but when I get down to the inputting information I get a 'Run-Time Error "438" Object Doesn't support this property or method.'
From the Previous answers on other similar questions I have done everything the way it was suggested however, I can't seem to get it to work.
Option Compare Database
Option Explicit
Public Sub MaterialInput()
Dim xlapp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim RsClient As Recordset
Dim RsJobsite As Recordset
Dim db As Database
Dim ClientSTR As String
Dim JobsiteSTR As String
Dim customer As Variant
Set db = CurrentDb
JobsiteSTR = "SELECT T1Jobsites.JobsiteNickName FROM T1Jobsites WHERE T1Jobsites.JobsiteID = 1" ' & Form_LEM.TxtJobsiteID
Set RsJobsite = db.OpenRecordset(JobsiteSTR, dbOpenSnapshot, dbSeeChanges)
ClientSTR = "SELECT T1Companies.CompanyName " & _
"FROM T1Companies INNER JOIN T1Jobsites ON T1Companies.CompanyID = T1Jobsites.CompanyId " & _
"WHERE (((T1Jobsites.JobsiteID)=1))"
'ClientSTR = "SELECT T1Companies.CompanyName FROM T1Companies INNER JOIN T1Jobsites ON T1Companies.CompanyID = T1Jobsites.CompanyID" & _
" WHERE T1JobsitesID = 1" '& Form_LEM.TxtJobsiteID
Set RsClient = db.OpenRecordset(ClientSTR, dbOpenSnapshot, dbSeeChanges)
Set xlapp = CreateObject("excel.application")
Set wb = xlapp.Workbooks.Open("C:\Users\coc33713\Desktop\VISION - EXCEL FILES\VISIONCOUNT.xlsm")
Set ws = xlapp.Worksheets("CountSheet")
xlapp.Visible = True
'Tried this second after reading another forum
'the comments Recordset will be the actual values used, but I can't get the String "TEST" to work
wb.ws.Range("Client").Value = "TEST" 'RsClient!CompanyName
'Tried this way first
xlapp.ws.Range("'SiteName'").Value = "Test" 'RsJobsite!JobsiteNickName"
xlapp.ws.Range(Date).Value = "Test" 'Form_LEM.TxtDate
xlapp.ws.Range(ProjectName).Value = "Test" 'Form_LEM.TxtPlant
xlapp.ws.Range(ScaffoldID).Value = "Test" 'Form_LEM.cboScaffnum.Value
xlapp.ws.Range(ScaffoldNumber).Value = "Test" 'Form_LEM.cboScaffnum.Column(1)
Set xlapp = Nothing
Set wb = Nothing
Set ws = Nothing
Set RsClient = Nothing
Set RsJobsite = Nothing
Set db = Nothing
End Sub
As a Sidenote this is not a form it is just spreadsheet
Thank you everyone!
Use
ws.Range("Client").Value = "Test"
Or
Dim sName as String
sName = "Client"
ws.Range(sName).Value = "Test"
Reason being is that you have the ws object set already, so there is no need to assign parentage to it again. In fact, trying to do so will break syntax rules.
FWIW (not your issue - that is solved by Scott's answer): Note that
Set ws = xlapp.Worksheets("CountSheet")
should be
Set ws = wb.Worksheets("CountSheet").
Using xlapp.Worksheets("CountSheet")
is effectively xlApp.ActiveWorkbook.Worksheets("CountSheet") which might be (and probably is) xlApp.Workbooks("VISION - EXCEL FILES\VISIONCOUNT.xlsm").Worksheets("CountSheet") but it is better to do it correctly rather than leave it to chance.
Thank you guys!
This should do what you want.
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("NamedRange1").Value
.Fields("FieldName2") = Range("NamedRange2").Value
.Fields("FieldNameN") = Range("NamedRangeN").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
Is there anyway of combining tables in access and the outputting them to excel when the results of the combine would be larger than the 255 field limit
Consider breaking up the query below the 255-column limit into multiple queries (all same structure). Then, open the queries as VBA recordsets to be copied into an Excel workbook at specific range for contiguous output, specifically using the CopyFromRecordset method.
Below is a generalized Access VBA solution assuming two queries with 200 columns each. Adjust particulars as needed. Instead of named objects, you can use an SQL statement inside OpenRecordset().
Dim xlApp As Object, xlWkb As object
Dim db As Database, rst1 As Recordset, rst2 As Recordset
Dim fld1 As Field, fld2 As Field
Dim i As Integer
Const xlOpenXMLWorkbook = 51
Set db = CurrentDb
Set rst1 = db.OpenRecordset("query1", dbOpenDynaset) ' FIRST 200 COLUMNS
Set rst2 = db.OpenRecordset("query2", dbOpenDynaset) ' NEXT 200 COLUMNS
Set xlApp = CreateObject("Excel.Application")
Set xlWkb = xlApp.Workbooks
' COLUMNS
i = 1
For Each fld1 in rst1.Fields
xlWkb.Sheets(1).Cells(1, i) = fld1.Name
i = i + 1
Next fld1
' DATA ROWS
xlWkb.Sheets(1).Cells(2, 1).CopyFromRecordset rst1
' COLUMNS
i = 0
For Each fld2 in rst2.Fields
xlWkb.Sheets(1).Cells(1, 201 + i) = fld2.Name
i = i + 1
Next fld2
' DATA ROWS
xlWkb.Sheets(1).Cells(2, 201).CopyFromRecordset rst2
xlWkb.SaveAs "C:\Path\To\Workbook\AccessData.xlsx", xlOpenXMLWorkbook
xlApp.Visible = True
rst1.Close: rst2.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set db = Nothing
Set xlWkb = Nothing
Set xlApp = Nothing