Solved: Access to an Open Excel File

[Ray0729]

Hi all. This is my frist post after just registering and I am hoping that someone can help me make sense of what I am doing here. I am fairly well versed in Access VBA, but I have run into a stumbling block. I have been task with moving all our manual processes of copying a query and pasting them into certain cells within an Excel input worksheet that will then be farmed out to different areas of the business. I am able to open the desired spreadsheet fine using VBA, but, I haven't ben able to determine a way to then access the already open form to input additional data. Parts of the code are below, any suggestions that anyone can provide would be of great value since I am about to pull my hair out here.


This section opens the desired spreadsheet



Set CDb = CurrentDb
Set objXLS = Excel.Application
With objXLS
.Visible = True
Set objWKB = Workbooks.Open (ConWKB_NAME)
Set objSht = objWKB.Worksheets (conSht_NAME)
End With
End Sub

What I'd like to see happen is something like this
If CountySelected = "003 - Allegheny County, PA" Then
Goto Above workbook into a specific range of cells and paste the results of a SQL query.


I am hoping that it is possible to activate a certain range of cells, dump the data, and then move onto the next action in a different range of cells. Again, if anyone has any suggestions please let me know...my wife may like me now, but maybe not so much if I go bald trying to make it work

-Ray

[Mavyak]

Sub Open_Workbook()
Dim objXLS As Excel.Application
Dim objSht As Excel.Worksheet
Dim objWKB As Excel.Workbook

Dim strSQL As String
Dim ConWKB_NAME As String
Dim ConSht_NAME As String

'Set CDb = CurrentDb '<--Don't need this line
Set objXLS = New Excel.Application

strSQL = getSQL()

ConWKB_NAME = "C:\Documents and Settings\Dad\Desktop\AccessToExcelTest.xls"
ConSht_NAME = "Sheet1"

With objXLS
.Visible = True
Set objWKB = Workbooks.Open(ConWKB_NAME)
Set objSht = objWKB.Worksheets(ConSht_NAME)
Export_Query_Results strSQL, objSht, "f2"
Set objSht = Nothing
objWKB.Close SaveChanges:=True
Set objWKB = Nothing
objXLS.Quit
End With
Set objXLS = Nothing
End Sub
Private Sub Export_Query_Results(ByVal strSQL As String, ByRef w As Excel.Worksheet, ByVal strRange As String)
Dim c As ADODB.Connection

Set c = New ADODB.Connection

With c
.ConnectionString = CurrentProject.Connection
.Open
w.Range(strRange).CopyFromRecordset .Execute(strSQL)
.Close
End With
Set c = Nothing
End Sub

Private Function getSQL() As String
Dim strSQL As String

strSQL = "SELECT *" & vbCr
strSQL = strSQL & "FROM ENTREES"

getSQL = strSQL
End Function


Holler back if any of that needs explaining. You will need to set the following two references:
Microsoft Excel X.xx Object Library
Microsoft ActiveX Data Objects X.xx Library

[Ray0729]

The first section of the code seems to be working correctly, opening the spreadsheet I have prompted it to open. I am receiving a bug at this section however

Private Sub Export_Query_Results(ByVal strSQL As String, ByRef w As Excel.Worksheet, ByVal strRange As String)
Dim c As ADODB.Connection

Set c = New ADODB.Connection

With c
.ConnectionString = CurrentProject.Connection
.Open
w.Range(strRange).CopyFromRecordset .Execute(strSQL)
.Close
End With
Set c = Nothing
End Sub

There error I am getting is 2147467259 - the database has been placed in a state by user "Admin" on machine "PC" that prevents it from being opened or locked. The error is occured at .Open

- Ray

[Mavyak]

Save everything, close teh database, reopen it, and run it fresh. When editing a module, the database gets "locked by admin."

[Ray0729]

Thanks, I have gotten past the locked by admin state. Now I appear to be running into a different issue. Shown below

Private Sub Export_Query_Results(ByVal strSQL As String, ByRef w As Excel.Worksheet, ByVal strRange As String)
Dim c As ADODB.Connection

Set c = New ADODB.Connection

With c
ConnectionString = CurrentProject.Connection
.Open
w.Range(strRange).CopyFromRecordset.Execute (strSQL)
.Close
End With
Set c = Nothing
End Sub

At the .CopyFromRecordset I am getting the error "Arguement not optional"

Everything else is working great.

- Ray

[Mavyak]

There should be a space between the t in CopyFromRecordset and the period in .Execute. The ".Execute" is a method of c (the ADODB.Connection). ".Execute(strSQL)" returns a recordset object that is passed as the argument to the ".CopyFromRecorset" method of the Range object.

[Ray0729]

Hoping this is the last error I get for the night. I appericate all the help you have provided. I am now getting another error at the .Open section. Error is - [Microsoft][ODBC Driver Manager] Data source name not found and no default driver specified.

Errors occurs in this section

Private Sub Export_Query_Results(ByVal strSQL As String, ByRef w As Excel.Worksheet, ByVal strRange As String)
Dim c As ADODB.Connection

Set c = New ADODB.Connection

With c
ConnectionString = CurrentProject.Connection
.Open
w.Range(strRange).CopyFromRecordset .Execute(strSQL)
.Close
End With
Set c = Nothing
End Sub

- Ray

[Mavyak]

Is the code running from a MS Access module?

[Ray0729]

No it's assigned as an Event Procedure to a command button.

[Mavyak]

There should be a period before ConnectionString:

.ConnectionString = CurrentProject.Connection

[Ray0729]

Thank you for all your help Mavyak it appears to be working as intended .

[Mavyak]

Glad to hear it, man. Counter-Strike time. :beerchug:

[Ray0729]

Guess I spoke too soon. Not sure if this is caused by the code or not but figured I'd have you look at it.

Private Sub Open_Workbook_Click()
Dim objXLS As Excel.Application
Dim objSht As Excel.Worksheet
Dim objWKB As Excel.Workbook
Dim strSQL As String
Dim ConWKB_NAME As String
Dim ConSht_NAME As String
Dim CmbSlct As String


CmbSlct = Me.CmbSlct
If CmbSlct = 1 Then
Set objXLS = New Excel.Application
strSQL = getSQL()
ConWKB_NAME = "C:\Documents and Settings\Ray Stacy\Desktop\Personal"
ConSht_NAME = "Sheet1"
With objXLS
.Visible = True
Set objWKB = Workbooks.Open(ConWKB_NAME)
Set objSht = objWKB.Worksheets(ConSht_NAME)
Export_Query_Results strSQL, objSht, "c2"
Set objSht = Nothing
objWKB.Close SaveChanges:=True
Set objWKB = Nothing
objXLS.Quit
End With
Set objXLS = Nothing
ElseIf CmbSlct = 2 Then
Set objXLS = New Excel.Application
strSQL = getSQL()
ConWKB_NAME = "C:\Documents and Settings\Ray Stacy\Desktop\Personal"
ConSht_NAME = "Sheet2"
With objXLS
.Visible = True
Set objWKB = Workbooks.Open(ConWKB_NAME)
Set objSht = objWKB.Worksheets(ConSht_NAME)
Export_Query_Results strSQL, objSht, "a2"
Set objSht = Nothing
objWKB.Close SaveChanges:=True
Set objWKB = Nothing
objXLS.Quit
End With
Set objXLS = Nothing
End If
End Sub

You can see where it has the ElseIf statement. Problem is, I haven't been able to see it writing over to the spreadsheet, each time I try to open the spreadsheet now it says that the spreadsheet is already open, problem is, I can't find it already open somewhere.

- Ray

[Mavyak]

Shouldn't the workbook name end in "*.xls"?

[Ray0729]

Didn't even notice that :doh: . Thanks for the catch.

- Ray