MSDE & Access 2003: Writing the results of VBA programmed in the Module of the .adp to Excel 2003
-
Hi all,
I have succeeded in executing the following VBA code in the Module of Access 2003:
Sub openADODB()
Dim cnn As Connection
Dim rst As Recordset
Dim str As String
Dim MyVar1 As String
Dim MyVar2 As String
'Create a Connection object after instantiating it,
'this time to a SQL Server database.
Set cnn = New ADODB.Connection
str = "Provider=SQLOLEDB;Data Source=<myComputerName>;" & _
"Database=adp1SQL;Integrated Security=SSPI;"
cnn.Open str
'Create recordset reference, and set its properties.
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
'Open recordset, and print some of the tested records.
rst.Open "CHIL0708A1", cnn
MyVar1 = "****************************** From Table: CHIL0708A1 ******************************"
Debug.Print MyVar1
MyVar2 = "SampleID LabSampleID AnalyteName Result Unit LabQualifier"
Debug.Print MyVar2
Do Until rst.EOF
' If rst!AnalyteName = "Acetone" And rst!LabQualifier = "D" Then
If rst!ResultUnits = "ug/m3" And rst!LabQualifier <> "U" Then
Debug.Print rst.Fields(0).Value, rst.Fields(3).Value, rst.Fields(6).Value, rst.Fields(7).Value, rst.Fields(8).Value, rst.Fields(9).Value
End If
rst.MoveNext
Loop
'Print a message in MsgBox
If cnn.State = adStateOpen Then
MsgBox "Connection was Successful!!!"
End If
'Clean up objects.
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
/////////////////////////////////
I got the following results printed in the "Inmmediate":
****************************** From Table: CHIL0708A1 ******************************
SampleID LabSampleID AnalyteName Result Unit LabQualifier
6990GLE(BASEMENT) 616784D1 Toluene 11 ug/m3 D
6990GLE(BASEMENT) 616784D1 Xylene (m,p) 3.0 ug/m3 D
6990GLE(BASEMENT) 616784D1 1,4-Dichlorobenzene 16 ug/m3 D
6990GLE(BASEMENT) 616784D1 Acetone 38 ug/m3 D
6990GLE(BASEMENT) 616784D1 Isopropyl alcohol 210 ug/m3 D
6990GLE(BASEMENT) 616784D1 Xylene (total) 3.0 ug/m3 D
6990GLE(BASEMENT) 616784 Isopropyl alcohol 230 ug/m3 E
600NICH(BASEMENT) 616785D1 Toluene 8.7 ug/m3 D
600NICH(BASEMENT) 616785D1 Tetrachloroethene 16 ug/m3 D
600NICH(BASEMENT) 616785D1 Isopropyl alcohol 640 ug/m3 D
600NICH(BASEMENT) 616785 Isopropyl alcohol 790 ug/m3 E
//////////////////////////////////////////
Is it possible to program the VBA to save/input the results in Microsoft Excel 2003? If it is possible, please tell me how to do it and give me the key code statements to achieve it.
Thanks in advance,
Scott Chang
-
I'm reposting because my first one didn't take.
Unless you want to be able to call this functionality from within a MS Access application (such as with the click of a command button) I wouldn't go this route. Although excel automation can be eaily implemented to accomplish what you think you want, it's not the best choice for this simple task.
Create a User DSN on your local machine with the SQL Server driver and connection settings from your code above. Open Excel and from the Data Menu, choose New Database Query, chose your newly created User DSN and the database query wizard will walk you through returning the data to Excel. Let me know if you need more direction or need to do it in VBA.
-
Hi JackSteezo, Thanks for your response.
Please give me more direction for doing it in VBA via Excel Automation.
Thanks again,
Scott Chang
-
'Paste all of this into a new module in MS Access. Most of the added code comes from 'The Access Web, but I added some steps and variables here to write you recordset 'output to Excel. This is kinda slow, watch for the excel files save dialog box to pop up. It 'may seem like your Access app has hung up, but it's waiting for you to save the 'dynamically created worksheet. Minimize the Access window and you'll see it pop up.
Option Compare Database
'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10
Private Declare Function apiFindWindow Lib "user32" Alias _
"FindWindowA" (ByVal strClass As String, _
ByVal lpWindow As String) As Long
Private Declare Function apiSendMessage Lib "user32" Alias _
"SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal _
wParam As Long, lParam As Long) As Long
Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
"SetForegroundWindow" (ByVal Hwnd As Long) As Long
Private Declare Function apiShowWindow Lib "user32" Alias _
"ShowWindow" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function apiIsIconic Lib "user32" Alias _
"IsIconic" (ByVal Hwnd As Long) As Long
Function fIsAppRunning(ByVal strAppName As String, _
Optional fActivate As Boolean) As Boolean
Dim lngH As Long, strClassName As String
Dim lngX As Long, lngTmp As Long
Const WM_USER = 1024
On Local Error GoTo fIsAppRunning_Err
fIsAppRunning = False
Select Case LCase$(strAppName)
Case "excel": strClassName = "XLMain"
Case "word": strClassName = "OpusApp"
Case "access": strClassName = "OMain"
Case "powerpoint95": strClassName = "PP7FrameClass"
Case "powerpoint97": strClassName = "PP97FrameClass"
Case "notepad": strClassName = "NOTEPAD"
Case "paintbrush": strClassName = "pbParent"
Case "wordpad": strClassName = "WordPadClass"
Case Else: strClassName = vbNullString
End Select
If strClassName = "" Then
lngH = apiFindWindow(vbNullString, strAppName)
Else
lngH = apiFindWindow(strClassName, vbNullString)
End If
If lngH <> 0 Then
apiSendMessage lngH, WM_USER + 18, 0, 0
lngX = apiIsIconic(lngH)
If lngX <> 0 Then
lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
End If
If fActivate Then
lngTmp = apiSetForegroundWindow(lngH)
End If
fIsAppRunning = True
End If
fIsAppRunning_Exit:
Exit Function
fIsAppRunning_Err:
fIsAppRunning = False
Resume fIsAppRunning_Exit
End Function
'******************** Code End ****************
Sub openADODB()
Dim cnn As Connection
Dim rst As Recordset
Dim str As String
Dim MyVar1 As String
Dim MyVar2 As String
'Variables added by Steven Plater
Dim intRow As Integer: intRow = 1 'Excel row pointer set to start at 1
'************ Code Start **********
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Dim objXL As Object
Dim strWhat As String, boolXL As Boolean
Dim objActiveWkb As Object
If fIsAppRunning("Excel") Then
Set objXL = GetObject(, "Excel.Application")
boolXL = False
Else
Set objXL = CreateObject("Excel.Application")
boolXL = True
End If
objXL.Application.workbooks.Add
Set objActiveWkb = objXL.Application.ActiveWorkBook
'***************************
'Create a Connection object after instantiating it,
'this time to a SQL Server database.
Set cnn = New ADODB.Connection
str = "Provider=SQLOLEDB;Data Source=<myComputerName>;" & _
"Database=adp1SQL;Integrated Security=SSPI;"
cnn.Open str
'Create recordset reference, and set its properties.
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
'Open recordset, and print some of the tested records.
rst.Open "CHIL0708A1", cnn
MyVar1 = "****************************** From Table: CHIL0708A1 ******************************"
Debug.Print MyVar1
MyVar2 = "SampleID LabSampleID AnalyteName Result Unit LabQualifier"
Debug.Print MyVar2
'Fill first row in excel spreadsheet with recordset field names as headers
For intCounter = 0 To rst.Fields.Count - 1
With objActiveWkb
.Worksheets(1).Cells(intRow, intCounter + 1) = rst.Fields(intCounter).NAME
End With
Next intCounter
intRow = intRow + 1
Do Until rst.EOF
' If rst!AnalyteName = "Acetone" And rst!LabQualifier = "D" Then
If rst!ResultUnits = "ug/m3" And rst!LabQualifier <> "U" Then
'Comment by Steve Plater
'in your recordset sql string I'd use a where clause like so "SELECT * FROM CHIL0708A1 WHERE ResultUnits = 'ug/m3' AND LabQualifier <> 'U'"
'that way you only return the records you need and don't need the if block starting above
'itereate through all columns in the recordset and sync output to excel cells
'since Excel cells start with (1,1) you have to adjust the column
For intCounter = 0 To rst.Fields.Count - 1
With objActiveWkb
.Worksheets(1).Cells(intRow, intCounter + 1) = rst.Fields(intCounter).Value
End With
Next intCounter
Debug.Print rst.Fields(0).Value, rst.Fields(3).Value, rst.Fields(6).Value, rst.Fields(7).Value, rst.Fields(8).Value, rst.Fields(9).Value
End If
'Increment excel row pointer with rst.MoveNext
intRow = intRow + 1
rst.MoveNext
Loop
'Print a message in MsgBox
If cnn.State = adStateOpen Then
MsgBox "Connection was Successful!!!"
End If
'Clean up objects.
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
objActiveWkb.Close savechanges:=True 'Will prompt you for a save location
If boolXL Then objXL.Application.Quit
Set objActiveWkb = Nothing: Set objXL = Nothing
End Sub
-
Hi JackSteezo, Thanks for your VBA code of Excel Automation.
I did what you instructed me to do: copied the code and ran it in a new Module of Access 2003. The code was executed without any error message. But I just got the 19 Field Titles of my adp1SQL file on the Excel 2003 Book - no VBA results were printed out on the Excel 2003 Book. I am studying/learning the VBA code you gave me and hope I can figure it out how to fix it for my purpose!!! It will take me a long time to get it right!!! Could you please re-examine the VBA code and tell me where it should be changed in order to print out the results I need in Excel 2003?
Many Thanks again,
Scott Chang
-
That should've worked, I tested it before I sent it. Make sure your recordset has data in it. You can test this by inserting a msgbox rst.count somewhere after you open the recordset to see what you get back, you should get back at least 1 row.
-
I had my access putting stuff into excell once using automation - I found it to be incredibly slow!!!
Anyone else find that? Im talking watching it filling in individual cells *yawnsnore*Instead of lots of automation and coding to get your data into excel, why not e.g. export a query to an excel spreadsheet?
Check the docmd.OutputTo command
You can export entire reports with formatting and expandable areas and all sorts.
you could also play with docmd.transferspreadsheet if your feeling hardcore
martin
-
Hi Martin, Thanks for your response.
The Access "Pivot Table" obtained from the original "Table" or resulted "Query" can be viewed only. If the Access "Pivot Table" is exported to MS Excel 2003, the "Pivot Table" formatting is lost. This is the reason I try to use ADO, MSDE and the .adp of Access 2003 to get my "Pivot Table" in Access 2003 and then exported to MS Excel 2003. (By the way, MS Excel 2003 can not produce the meaningful "Pivot Table" directly itself!!!!).
I am new in doing the ADO and MSDE/MS SQL Server 2000 programming. Could you please give me more direction on the docmd.OutputTocommand and Command FieldObjects?
Thanks again,
Scott Chang
-
I'm not found of such a slow method either. But he asked!
Viewing 9 posts - 1 through 8 (of 8 total)
You must be logged in to reply to this topic. Login to reply