Hi All
' -------> Adding NewDataSheet in Run Time
DataTable.AddSheet "MySheet"
' -------> Adding Column name in Run time
'DataTable.GetSheet("MySheet").AddParameter "bname"," "
' -------> Create DataBase Connection
Set objCon = CreateObject("ADODB.Connection")
' objCon.Open"Provider=SqlOledb.1;Server=sys;uid=sa;pwd=;database=bankdb1"
(OR)
' -------> Open DataBase Connection
objCon.Open"Provider=Microsoft.Jet.Oledb.4.0;Data Source=D:\NewDB.mdb"
' -------> Creating Record set for DataSet
Set objRs=CreateObject("adodb.recordset")
' -------> Opening RecodSet form DataBase
objRs.open"select * from Emp",objCon
' -------> Loop for Getting DataBase Column name
For intCount = 1 to objRs.Fields.Count-1
i = 1
DataTable.GetSheet("MySheet").AddParameter objRs.Fields(intCount).Name,"
"
' -------> Loop for Checking end of the Recod
While objRs.eof<>true
' -------> Seting the current row
DataTable.SetCurrentRow(i)
' -------> increments for data table row
i=i+1
' -------> Assigning the DataBase Values into DataTable
DataTable.Value(objRs.Fields(intCount).Name,"MySheet") =
objRs.Fields(intCount).Value 'This one
' -------> moving the record pointed to next record
objRs.MoveNext
Wend
' -------> moving the record pointed to First record
objRs.MoveFirst
Next
' -------> Exporting the results in local
DataTable.ExportSheet"D:\MyTest.xls",3
Regards,
Rameshwar
On Tue, Mar 22, 2011 at 2:32 PM, Regan Charles <[email protected]>wrote:
> HI Dixit,
>
> Please find the code to Export data from database to excel
>
>
> ----------------------------------------------------------------------------------
>
> Private Sub ArchiveGenerateReport_Click()
> Dim obj_connect As Object
> Dim ObjCon As New ADODB.Connection
> Dim ObjRs As New ADODB.Recordset
> Dim strConnection As String
> Dim strConString As String
>
> strPath = ActiveWorkbook.path
> a = Len(strPath)
> ChDrive (Left(strPath, a))
> ChDir (strPath)
> ChDir ("..\EmployeeDirectoryV1.0")
> strPath = CurDir
> strDatabase = strPath & "\" & "\DB\DatasetProgNameTracker.mdb"
> strConString = "Driver={Microsoft Access Driver (*.mdb)};DBQ=" &
> strDatabase & ";ReadOnly=True;"
> ObjCon.Open strConString
>
> ObjRs.CursorType = adOpenKeyset
> ObjRs.LockType = adLockOptimistic
> ObjRs.Open "Archive", ObjCon, , , adCmdTable
> If ObjRs.EOF Then
> MsgBox ("Unable to Generate Report - No REPORT FOUND IN THE DATABASE")
> Else
> Set fs = CreateObject("Scripting.FileSystemObject")
> Set a = fs.CreateTextFile(strPath & "\" &
> "\Report\ArchivedEmployees.csv", True)
> a.WriteLine ("Employee ID" & ", " & "Employee Name" & ", " & "Date of
> Birth" & ", " & "Mobile Number" & ", " _
> & "Asset ID" & ", " & "IP Address" & ", " & "Date of Joining in Project"
> _
> & ", " & "Date of Joining in Polaris" & ", " & "RSA Token Number" & ", "
> & "markitSERVID EmailID" _
> & ", " & "derivSERVID Email ID" & ", " & "Email ID" & ", " & "Passport
> Number" & ", " & "PAN Number" & ", " & "WorkLocation" & ", " &
> "WorkExtension" _
> & ", " & "Reporting Manager" & ", " & "JobStatus" & ", " & "JobTitle" &
> ", " & "ProjectName" & ", " & "Previous Project Status" & ", " & "Total
> Experience" _
> & ", " & "Experience in Testing" & ", " & "Present Location" & ", " &
> "Willing to Onsite Assignment" & ", " & "Resource Category" & ", " &
> "Project Category" _
> & ", " & "Intra Project Division" & ", " & "Intra Project Division Name"
> & ", " & "Date of Relieve" & ", " & "Person Taking Over" & ", " &
> "SuperVisor" & ", " & "Group/SEC")
>
>
> ObjRs.Filter = ""
> ObjRs.Filter = "AllIndicator= 'All' "
> ObjRs.MoveFirst
> Do While Not ObjRs.EOF
> a.WriteLine (ObjRs.Fields("DBEmpID") & ", " &
> ObjRs.Fields("DbEmpName") & ", " & ObjRs.Fields("DBDOB") & ", " &
> ObjRs.Fields("DBMobileNum") & ", " _
> & ObjRs.Fields("DBAssetID") & ", " &
> ObjRs.Fields("DBIPAddress") & ", " & ObjRs.Fields("DBDOJ") & ", " &
> ObjRs.Fields("DBDOJPolairis") _
> & ", " & ObjRs.Fields("DBRSATokenID") & ", " &
> ObjRs.Fields("DBMarkitSERVID") & ", " & ObjRs.Fields("DBDTCCID") & ", " &
> ObjRs.Fields("DBPolarisID") _
> & ", " & ObjRs.Fields("DBPassportNumber") & ", " &
> ObjRs.Fields("DBPanNumber") & ", " & ObjRs.Fields("DBWorkLocation") & ", " &
> ObjRs.Fields("DBWorkExtension") & ", " & ObjRs.Fields("DBReportingManager")
> & ", " & ObjRs.Fields("DBJobStatus") _
> & ", " & ObjRs.Fields("DBJobTitle") & ", " &
> ObjRs.Fields("DBProjectName") & ", " & ObjRs.Fields("DBPreviousProjectName")
> & ", " & ObjRs.Fields("DBTotalExperience") _
> & ", " & ObjRs.Fields("DBTestingExperience") & ", " &
> ObjRs.Fields("DBPresentLocation") & ", " & ObjRs.Fields("DBOnsiteWish") & ",
> " & ObjRs.Fields("DBResourceCategory") _
> & ", " & ObjRs.Fields("DBProjectCategory") & ", " &
> ObjRs.Fields("DBSubProjectCategory") & ", " &
> ObjRs.Fields("DBSubMiniProjectCategory") & ", " &
> ObjRs.Fields("DBDateofRelieving") & ", " &
> ObjRs.Fields("DBPersonTakingOver") & ", " & ObjRs.Fields("DBSupervisor") &
> ", " & ObjRs.Fields("DbSEC"))
> ObjRs.MoveNext
>
> Loop
>
> For irow = 2 To 200
> For icol = 1 To 33
> MyMasterDetail.Cells(irow, icol) = ""
> Next
> Next
>
> dbirow = 2
> ObjRs.MoveFirst
> Do While Not ObjRs.EOF
>
> MyMasterDetail.Cells(dbirow, 1) = ObjRs.Fields("DBEmpID")
> MyMasterDetail.Cells(dbirow, 2) = ObjRs.Fields("DbEmpName")
> MyMasterDetail.Cells(dbirow, 3) = ObjRs.Fields("DBDOB")
> MyMasterDetail.Cells(dbirow, 4) = ObjRs.Fields("DBMobileNum")
> MyMasterDetail.Cells(dbirow, 5) = ObjRs.Fields("DBAssetID")
> MyMasterDetail.Cells(dbirow, 6) = ObjRs.Fields("DBIPAddress")
> MyMasterDetail.Cells(dbirow, 7) = ObjRs.Fields("DBDOJ")
> MyMasterDetail.Cells(dbirow, 8) =
> ObjRs.Fields("DBDOJPolairis")
> MyMasterDetail.Cells(dbirow, 9) =
> ObjRs.Fields("DBRSATokenID")
> MyMasterDetail.Cells(dbirow, 10) =
> ObjRs.Fields("DBMarkitSERVID")
> MyMasterDetail.Cells(dbirow, 11) = ObjRs.Fields("DBDTCCID")
> MyMasterDetail.Cells(dbirow, 12) =
> ObjRs.Fields("DBPolarisID")
> MyMasterDetail.Cells(dbirow, 13) =
> ObjRs.Fields("DBPassportNumber")
> MyMasterDetail.Cells(dbirow, 14) =
> ObjRs.Fields("DBPanNumber")
> MyMasterDetail.Cells(dbirow, 15) =
> ObjRs.Fields("DBWorkLocation")
> MyMasterDetail.Cells(dbirow, 16) =
> ObjRs.Fields("DBWorkExtension")
> MyMasterDetail.Cells(dbirow, 17) =
> ObjRs.Fields("DBReportingManager")
> MyMasterDetail.Cells(dbirow, 18) =
> ObjRs.Fields("DBJobStatus")
> MyMasterDetail.Cells(dbirow, 19) = ObjRs.Fields("DBJobTitle")
> MyMasterDetail.Cells(dbirow, 20) =
> ObjRs.Fields("DBProjectName")
> MyMasterDetail.Cells(dbirow, 21) =
> ObjRs.Fields("DBPreviousProjectName")
> MyMasterDetail.Cells(dbirow, 22) =
> ObjRs.Fields("DBTotalExperience")
> MyMasterDetail.Cells(dbirow, 23) =
> ObjRs.Fields("DBTestingExperience")
> MyMasterDetail.Cells(dbirow, 24) =
> ObjRs.Fields("DBPresentLocation")
> MyMasterDetail.Cells(dbirow, 25) =
> ObjRs.Fields("DBOnsiteWish")
> MyMasterDetail.Cells(dbirow, 26) =
> ObjRs.Fields("DBResourceCategory")
> MyMasterDetail.Cells(dbirow, 27) =
> ObjRs.Fields("DBProjectCategory")
> MyMasterDetail.Cells(dbirow, 28) =
> ObjRs.Fields("DBSubProjectCategory")
> MyMasterDetail.Cells(dbirow, 29) =
> ObjRs.Fields("DBSubMiniProjectCategory")
> MyMasterDetail.Cells(dbirow, 30) =
> ObjRs.Fields("DBDateofRelieving")
> MyMasterDetail.Cells(dbirow, 31) =
> ObjRs.Fields("DBPersonTakingOver")
> MyMasterDetail.Cells(dbirow, 32) =
> ObjRs.Fields("DBSupervisor")
> MyMasterDetail.Cells(dbirow, 33) = ObjRs.Fields("DbSEC")
>
> ObjRs.MoveNext
> dbirow = dbirow + 1
> Loop
>
>
>
> UserForm2.WhatiUploadedEmpID.Caption = "Report has been generated for
> Mater Details of " & Trim(UserForm2.ResourceCategoryCombo.Value)
> 'messageLabel.Caption = "Report has been Generated
> Successfully"
> 'messageLabel.Caption = "Please Find your Report from the Path
> " & strPath
> 'MsgBox ("Report has been Generated Successfully" & strPath &
> "\Report")
> End If
> End Sub
>
> --------------------------------------------------------------------------------------------------------------------------------------------------------
>
>
> Please contact me if you have any clarifications. --99625 18437
>
> Thanks and Regards
> Regan Charles.S
>
>
> On Mon, Mar 21, 2011 at 10:06 PM, Shalabh Dixit
> <[email protected]>wrote:
>
>> Guys...
>>
>> I need to export the data from database table to a excel sheet and to
>> datatable as well.
>>
>> Request you to please provide your valuable inputs...
>>
>> Below is the code I tried but didn't worked... :(
>>
>> Set objDB = CreateObject("ADODB.Connection")
>> objDB.ConnectionString = "Provider=SQLOLEDB.1;Password=1234;Persist
>> Security Info=True;User ID=sa;Initial Catalog=AdventureWorks;Data
>> Source=SHALABHDIXIT-PC"
>> objDB.Open
>>
>> If objDB.state=1 Then
>> msgbox("Connection Is Establsihed")
>> else
>> msgbox("Connection is not opened")
>> exittest
>> End If
>>
>> sql_query = "select DepartmentID, Name from HumanResources.Department"
>>
>> Set objResults = objDB.Execute(sql_query )
>>
>> Set s=datatable.GetSheet ("Global")
>> Set deptID=s.addparameter("DepartmentID", " ")
>> Set deptName=s.addparameter("Name", " ")
>>
>> Do Until objResults.EOF
>> DataTable.SetNextRow
>> deptID.value = objResults("DepartmentID")
>> deptName.value = objResults("Name")
>> msgbox deptID & " " & " "& deptName
>> objResults.MoveNext
>> Loop
>>
>> DataTable.ExportSheet "E:\DATA\Test.xls"
>> msgbox "The file is saved in E:\DATA\Test.xls"
>>
>> objResults.Close
>> objDB.Close
>>
>> --
>> You received this message because you are subscribed to the Google
>> "QTP - HP Quick Test Professional - Automated Software Testing"
>> group.
>> To post to this group, send email to [email protected]
>> To unsubscribe from this group, send email to
>> [email protected]
>> For more options, visit this group at
>> http://groups.google.com/group/MercuryQTP?hl=en
>
>
> --
> You received this message because you are subscribed to the Google
> "QTP - HP Quick Test Professional - Automated Software Testing"
> group.
> To post to this group, send email to [email protected]
> To unsubscribe from this group, send email to
> [email protected]
> For more options, visit this group at
> http://groups.google.com/group/MercuryQTP?hl=en
>
--
You received this message because you are subscribed to the Google
"QTP - HP Quick Test Professional - Automated Software Testing"
group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/MercuryQTP?hl=en
