|
-
Jul 14th, 2003, 04:03 AM
#1
Thread Starter
Addicted Member
sql results in excel
The following code shows that if I run the micro command in the first sheet (sheet1) of my workbook then the results of the query they will be presented in sheet1.
What changes should I make in the code in order to are presented the results in an other sheet e.g. Sheet2.
Sub Refresh()
'Declare variables
Dim OraSession As Object
Dim OraDatabase As Object
Dim EmpDynaset As Object
Dim flds() As Object
Dim fldcount As Integer
Dim userentry As String
Dim dtentryFROM As Date
Dim dtentryTO As Date
Dim strdtfrom As String
Dim strdtto As String
'dtentryTO = Format(dd / mm / yyyy)
strdtfrom = InputBox("From Date:")
strdtto = InputBox("To Date:")
userentry = InputBox("Please give User")
Set OraSession = CreateObject("OracleInProcServer.XOraSession")
Set OraDatabase = OraSession.OpenDatabase("mydb", "username/pass", 0&)
Set EmpDynaset = OraDatabase.CreateDynaset("SELECT ROWNUM, tbl1, tbl2 FROM data WHERE date>= TO_DATE ('" + strdtfrom + "', 'DD/MM/RRRR') AND date< TO_DATE ('" + strdtto + "', 'DD/MM/RRRR') AND user = " + userentry + " ORDER BY date, ROWNUM", 0&)
'Set objSht = objWkb.Worksheets(class)
'Worksheets(class).
Range("A2:C2000").Select
'Range("A2:C2000").Select
Selection.ClearContents
'Declare and create an object for each column.
'This will reduce objects references and speed
'up your application.
fldcount = EmpDynaset.Fields.Count
ReDim flds(0 To fldcount - 1)
For colnum = 0 To fldcount - 1
Set flds(colnum) = EmpDynaset.Fields(colnum)
Next
'Insert Column Headings
'For Colnum = 0 To EmpDynaset.Fields.Count - 1
'ActiveSheet.Cells(1, Colnum + 1) = flds(Colnum).Name
'Next
'Display Data
For Rownum = 2 To EmpDynaset.RecordCount + 1
For colnum = 0 To fldcount - 1
ActiveSheet.Cells(Rownum, colnum + 1) = flds(colnum).Value
Next
EmpDynaset.MoveNext
Next
Range("A2:A2").Select
End Sub
-
Jul 14th, 2003, 05:04 AM
#2
Thread Starter
Addicted Member
-
Jul 14th, 2003, 06:11 AM
#3
Member
Replace your ActiveSheet references with you're own objects
You can reference any worksheet in any workbook as an object.
e.g. Reference a named sheet that already exists...
Code:
Dim ws as Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet2")
e.g. A new sheet in the current workbook...
Code:
Dim ws as Worksheet
Set ws = ActiveWorkbook.Sheets.Add
ws.Name = "New Sheet"
e.g. A new sheet in a new workbook...
Code:
Dim ws as Worksheet
Set ws = Application.Workbooks.Add.Sheets.Add
-
Jul 14th, 2003, 06:28 AM
#4
Thread Starter
Addicted Member
i put this
Dim XL As Excel.Application
Dim Wkb As Excel.Workbook
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("sheet2")
and i get data again on sheet1??
-
Jul 14th, 2003, 06:59 AM
#5
Member
Replace your Activesheet refs
Did you replace your ActiveSheet references with ws??
-
Jul 14th, 2003, 11:11 AM
#6
Frenzied Member
How about this?
VB Code:
Private Function GenerateReport(oData As ADODB.Recordset, Name As String) As String
On Error GoTo ERR_GenerateReport
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim sFile As String
Dim sDirectory As String
Dim lCtr As Long
'**************************************************************
'* Make the report directory if it doesn't already exist . . .
'**************************************************************
sDirectory = mReportRootDirectory & "\" & Replace(Name, Chr(32), "")
If Dir(sDirectory, vbDirectory) = vbNullString Then
MkDir sDirectory
SetAccess "Everyone", sDirectory, 0&
SetAccess "SQLExec", sDirectory, GENERIC_READ Or GENERIC_EXECUTE Or DELETE Or GENERIC_WRITE
SetAccess Environ$("USERNAME"), sDirectory, GENERIC_READ Or GENERIC_EXECUTE Or DELETE Or GENERIC_WRITE Or GENERIC_ALL
App.LogEvent "Created Directory '" & sDirectory & "'", vbLogEventTypeInformation
End If
'*****************************************************************************************
'* Get the XL objects. These are late bound because Microsoft change versions often . . .
'*****************************************************************************************
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Sheet1")
'********************************
'* Add the column headings . . .
'********************************
For lCtr = 0 To oData.Fields.Count - 1
xlWs.Cells(1, lCtr + 1) = oData.Fields(lCtr).Name
Next
'*****************************
'* Copy data and format . . .
'*****************************
xlWs.Cells(2, 1).CopyFromRecordset oData
xlApp.Selection.CurrentRegion.Columns.Autofit
'********************************
'* Save the file, and quit . . .
'********************************
sDirectory = Right$(sDirectory, Len(sDirectory) - 3) 'strip of leading drive letter e.g 'c:\'
sDirectory = "\\" & Environ$("COMPUTERNAME") & "\" & sDirectory
sFile = sDirectory & "\" & Format$(Now, "yyyymmddhhnnss") & Replace(Name, Chr(32), "")
xlWb.SaveAs sFile
xlApp.quit
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
GenerateReport = sFile
Exit Function
ERR_GenerateReport:
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
GenerateReport = vbNullString
End Function
-
Jul 14th, 2003, 04:17 PM
#7
New Member
try this
Range("sheet2!A1:C1000").select
-
Jul 15th, 2003, 12:16 AM
#8
Thread Starter
Addicted Member
i replace the ws...
my code now is :
Private Sub OKclass_Click()
Dim OraSession As Object
Dim OraDatabase As Object
Dim EmpDynaset As Object
Dim flds() As Object
Dim fldcount As Integer
Dim userentry As String
Dim dtentryFROM As Date
Dim dtentryTO As Date
Dim strdtfrom As String
Dim strdtto As String
'Dim XL As Excel.Application
'Dim Wkb As Excel.Workbook
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("class")
'dtentryTO = Format(dd / mm / yyyy)
strdtfrom = InputBox("From Date:")
strdtto = InputBox("To Date:")
userentry = InputBox("Please give User_Id")
Set OraSession = CreateObject("OracleInProcServer.XOraSession")
Set OraDatabase = OraSession.OpenDatabase("mydb", "username/pass", 0&)
Set EmpDynaset = OraDatabase.CreateDynaset("SELECT ROWNUM,tbl1,tbl2 Data WHERE date >= TO_DATE ('" + strdtfrom + "', 'DD/MM/RRRR') AND date < TO_DATE ('" + strdtto + "', 'DD/MM/RRRR') AND user = " + userentry + " ORDER BY date, ROWNUM", 0&)
'Range("sheet2!A1:C1000").Select
Range("A2:C2000").Select
Selection.ClearContents
'Declare and create an object for each column.
'This will reduce objects references and speed
'up your application.
fldcount = EmpDynaset.Fields.Count
ReDim flds(0 To fldcount - 1)
For colnum = 0 To fldcount - 1
Set flds(colnum) = EmpDynaset.Fields(colnum)
Next
'Insert Column Headings
'For Colnum = 0 To EmpDynaset.Fields.Count - 1
'ActiveSheet.Cells(1, Colnum + 1) = flds(Colnum).Name
'Next
'Display Data
For Rownum = 2 To EmpDynaset.RecordCount + 1
For colnum = 0 To fldcount - 1
ActiveSheet.Cells(Rownum, colnum + 1) = flds(colnum).Value
Next
EmpDynaset.MoveNext
Next
Range("A2:A2").Select
End Sub
and the "Range("sheet2!A1:C1000").Select"
don' work stops with en error msg!!
-
Jul 15th, 2003, 11:29 AM
#9
Member
Look at the post above
alazarou,
look at yrwyddfa's post above because it clearly shows how to do it. These are the important steps...
This code below gets the Excel objects and creates a reference to Sheet1 called xlWs. If your code is running inside Excel you don't need the first two lines. If you want your records on sheet2 then replace "Sheet1" with "Sheet2".
Code:
'*****************************************************************************************
'* Get the XL objects. These are late bound because Microsoft change versions often . . .
'*****************************************************************************************
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets("Sheet1")
The next section adds the column headings to the first row of the worksheet- I notice that you have some very similar code in your post. There is no need to copy the headings into an array before putting them on the worksheet. Notice how xlWs is at the start of the statement. Change 'oData' to the name of your dynaset object.
Code:
'********************************
'* Add the column headings . . .
'********************************
For lCtr = 0 To oData.Fields.Count - 1
xlWs.Cells(1, lCtr + 1) = oData.Fields(lCtr).Name
Next
The next section gets the data using the mucho efficient CopyFromRecordset method - using "xlWs" again. Then the Autofit method is called to set all the column widths to match the data. Change xlApp to Application if you are working in Excel VBA. You will also need to change oData again.
Code:
'*****************************
'* Copy data and format . . .
'*****************************
xlWs.Cells(2, 1).CopyFromRecordset oData
xlApp.Selection.CurrentRegion.Columns.Autofit
It should be as simple as that. Does this help any??
-
Jul 15th, 2003, 11:25 PM
#10
Thread Starter
Addicted Member
ok this was very helpful !!
thank you all guys!!!
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|