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=enPrivate 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" & ", " & "Polaris 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
