Writing to Named Cells in Excel from Access - excel

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

Related

How do I close an Excel spreadsheet in VBA code?

I have the following routine below that is meant to open an Excel spreadsheet and then go row by row to import the results into a table that is passed in. It works fine but the problem is if I try to open that same spreadsheet a second time I get a message that the file is in use and I have to Ctrl-Alt-Del to shut down Excel before I can use it again. I thought that the Set mySheet=Nothing and Set xlApp=Nothing would release the file but apparently not. What more can I do to make sure that Access lets go of the Excel file? Thanks in advance!
Public Sub MakeTempTable(strFilePath As String, tablename As String)
Dim mySheet As Object
Dim xlApp As Object
Dim rs As DAO.Recordset
Dim sql As String
sql = "DELETE * FROM " & tablename
DoCmd.RunSQL sql
Set rs = CurrentDb.OpenRecordset(tablename)
Set xlApp = CreateObject("Excel.Application")
Set mySheet = xlApp.Workbooks.Open(strFilePath).Sheets(1)
xlApp.Visible = False
Set mySheet = xlApp.Sheets("Input")
Dim dRows As Double
dRows = 1
Dim dRow As Double, dCol As Double
dRow = 2
On Error GoTo ERR
Do
dCol = 1
rs.AddNew
If mySheet.cells(dRow, 3) = "" Then Exit Do
Do
If mySheet.cells(dRow, dCol).Value <> "_END_" Then
rs.Fields(dCol).Value = Nz(mySheet.cells(dRow, dCol).Value, "")
dCol = dCol + 1
Else
Exit Do
End If
Loop
rs.Update
dRow = dRow + 1
Loop
EXITSUB:
Set mySheet = Nothing
Set xlApp = Nothing
Exit Sub
ERR:
If ERR.Number = 3265 Then MsgBox "The species selected are incompatible. Canceling import.", vbCritical, "IMPORT ERROR"
GoTo EXITSUB
End Sub
Try using
xlApp.Quit
When you set xlApp to nothing you are only clearing the object within the procedure, you aren't doing anything to the actual Excel instance. All that setting XXX = nothing allows you to do is then reuse that object.
You will need to legally close the workbooks that are open as in
xlApp.Workbooks.Close
EXITSUB:
This will close the instances that are open.
Prior to this, kill all the instances or reboot your machine to clear all the instances that are open.

Importing a list from SharePoint to Excel as a Range (or with a fixed Table name)

so I have the code below that pulls a list from SharePoint and imports it to Excel. My problem is, it imports it as a Table not as a Range and I cannot automatically convert it to range as the Table name is different every time I run the script (Table1, Table2, ... and so on).
My question is the following: Can I import the list from SharePoint as an Excel Range straight away, so that I don't have to convert it? If not, can I make it so every time I run the import procedure the name of the imported Table is fix?
Here's my code:
Sub SharePoint_Import()
Dim objMyList As ListObject
Dim objWksheet As Worksheet
Dim strSPServer As String
Const SERVER As String = "xxxx.xxxxx.xxx.net/xxxx/xxxx" 'SP server
Const LISTNAME As String = "{1234567-1234-1234-1234-1234567891}" 'SP List ID
Const VIEWNAME As String = ""
Set RData = Sheets("rawdata") 'reset import sheet
RData.UsedRange.ClearContents
strSPServer = "https://" & SERVER & "/_vti_bin" '<- _vti_bin is necessary
Set objWksheet = RData
Set objMyList = objWksheet.ListObjects.Add(xlSrcExternal, Array(strSPServer, LISTNAME, VIEWNAME), False, , Range("A1"))
Set objMyList = Nothing
Set objWksheet = Nothing
End Sub
Do this
[1] Change RData.UsedRange.ClearContents to RData.Cells.Clear. This will clear the sheet completely. Removes formats, text, tables etc..
[2] Once the table is imported, add this code. Since there is going to be only one table, you can use the table number to work with it.
Dim tbl As ListObject
Set tbl = RData.ListObjects(1)
Dim tblRng As Range
Set tblRng = tbl.Range
'~~> Convert table to range
tbl.Unlist
'~~> Comment this in case you do not
'~~> want to remove the formatting
With tblRng
.Interior.ColorIndex = xlColorIndexNone
.Font.ColorIndex = xlColorIndexAutomatic
.Borders.LineStyle = xlLineStyleNone
End With
You can query a Sharepoint list using ADODB. Check the following code (untested because I don't have Sharepoint available, but have used something similar in the past)
Const SERVER As String = "xxxx.xxxxx.xxx.net/xxxx/xxxx" 'SP server
Const LISTNAME As String = "{1234567-1234-1234-1234-1234567891}" 'SP List ID
Dim connStr As String
Dim conn As New ADODB.Connection
Dim rs As ADODB.Recordset
connStr = "Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=1;RetrieveIds=Yes;" _
& "DATABASE=" & SERVER _
& ";LIST=" & LISTNAME & ";"
conn.Open connStr
Set rs = conn.Execute("select * from list")
Dim rData As Worksheet
Set rData = thisworknbook.Sheets("rawdata") 'reset import sheet
rData.UsedRange.ClearContents
rData.Range("A1").CopyFromRecordset rs
conn.Close

Loop through Access database and perform basic operations using Excel VBA

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!

Exporting Access query results by record to new worksheet in file

I'm trying to workout how to split the unique records of a query to new worksheets in the same excel workbook (template file). My access query has the following fields:
Project Number,Project Name,Task Number,Project Sponsor,Full Year Budget,APR,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec,Jan,Feb,Mar,Full,Year Forecast.
I want to be able to have a new worksheet for each Project Number and list the relevant data, and also rename the worksheet as the Project Number...I have a complete mind block after spending hours playing around with other code for similar requests, but cannot get anything to behave the way I need it to?
Does any one have a ideas or could point me in the right direction, I'm not a complete novice at vba but this one has me well and truly stuck.
Many thanks :)
Hi All, thanks for the suggestions, I've managed to cobble together the code to spilt the data and export to individual worksheets and its working ok.I now need to copy over any associated data from another query to the relevant worksheet in a "table" below the other data, but I'm not having much luck. Either it will copy one record to one of the worksheets or all of the records to a single worksheet irrespective. Can anyone point me in the right direction?
Option Compare Database
Global iter As Integer
Sub Loop_Practice2()
Dim rs As DAO.Recordset
Dim ProjectNumber As DAO.Recordset
Dim i As Integer
Dim j As Integer
Dim Worksheet_Count As Integer
Dim sSql As String
Dim Project_Count As Integer
Dim iCol As Integer
Dim mypath As String
Dim mvalue As String
Dim myfile As String
Dim mynewfile As String
Dim mynewpath As String
Dim wb As Excel.Workbook
Dim WS As Excel.Worksheet
Dim sFile As String
mypath = Application.CurrentProject.Path & "\"
myfile = ("PIN Export Template.xlsx")
mynewpath = (Application.CurrentProject.Path & "\")
mynewfile = ("PIN Export Template.xlsx - " & Format(Now(), "yyyy-mm-dd") & ".xlsx")
sFile = mypath & myfile
' ' Use Dir to check if file exists
If Dir(sFile) = "" Then
' if file does not exist display message
MsgBox "Could not find the file " & sFile & " - Please ensure it is in the same location as the database."
Exit Sub
End If
'Open Excel
Excel.Application.Visible = True
Excel.Application.Workbooks.Open (sFile)
'Define Access Query to be exported
Set ProjectNumber = CurrentDb.OpenRecordset("SELECT DISTINCT qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly.[Project Number] from qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly")
If ProjectNumber.EOF Then Exit Sub
ProjectNumber.MoveLast
Project_Count = ProjectNumber.RecordCount - 1
ProjectNumber.MoveFirst
'Create individual PIN sheets from Query Dataset
Excel.Application.Worksheets("PIN").Select
Worksheet_Count = Excel.Application.Worksheets("PIN").Select
Do Until Worksheet_Count = Project_Count
Worksheets("PIN").Copy After:=Worksheets("PIN")
If iter = 0 Then
iter = 1
End If
ActiveSheet.Name = ("PIN") & iter
iter = iter + 1
Worksheet_Count = Worksheet_Count + 1
Loop
j = 1
'Add qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly data
Do Until ProjectNumber.EOF
sSql = "SELECT *"
sSql = sSql & " FROM qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly"
sSql = sSql & " Where qry_MP_PDP_PIN_Analysis_Step_01_FY_Position_Monthly.[Project Number]=" & ProjectNumber("[Project Number]")
Set rs = CurrentDb.OpenRecordset(sSql, dbOpenDynaset)
Set Pin_Sheet = ActiveWorkbook.Sheets("PIN" & j)
'Rename the PIN sheet to individual Project Number
Pin_Sheet.Name = ProjectNumber("[Project Number]")
'Create PIN Analysis Column Headings
For iCol = 0 To rs.Fields.Count - 1
Pin_Sheet.Cells(13, iCol + 4).Value = rs.Fields(iCol).Name
Next
'Populate PIN_Analysis_Step_01_FY_Position_Monthly Data
Pin_Sheet.Cells(14, 4).CopyFromRecordset rs
j = j + 1
ProjectNumber.MoveNext
Loop
Excel.Application.ActiveWorkbook.SaveAs (mynewpath & mynewfile)
Set Pin_Sheet = Nothing
Set ProjectNumber = Nothing
Set ProjectNumber2 = Nothing
Set rs = Nothing
Set ProjectNumber = Nothing
Set wb = Nothing
Set WS = Nothing
CurrentDb.Close
ActiveWorkbook.Close
Excel.Application.Quit
End Sub
AS 'Erik von Asmuth' Suggested it is a broad question split into a different task and share your code. what you have attempted until now.
I can only point you to one article written by Daniel Pineault . He had created a function called ExportRecordset2XLS through which you can pass your recordset, Sheet Name etc.
you have to create a loop for different project number and pass as an argument to this function. you also need to modify this code to handle differnt task as per your requiremnts.
https://www.devhut.net/2017/03/15/ms-access-vba-export-recordset-to-excel/

Output custom query to Excel format in MS Access

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

Resources