First add refrence Microsoft Excel 9.0 Object library
then use idea from this code i think its gonna help u
Private Sub Command1_Click()
On Error GoTo err:
Call StartExcelS
Call CreateWorkSheetS
Call PopulateWorkSheetS
Call SaveWorkSheetS
Call CloseWorkSheetS
Exit Sub
err:
MsgBox "Error Number: " & err.Number & "; " & err.Description, vbOKOnly + vbCritical
End Sub
Private Sub StartExcelS()
On Error GoTo err:
l5.Caption = "Opening Excel"
Set Excel = GetObject(, "Excel.Application") ' Create Excel Object.
'Well you have to do like this.
'Above line if I used CreateObject, 1st time it would
'work fine but the second time my program would
'hang.Well I found this the easiest way to do it.
'But you can do it another way if you like.
'By default after creating the Excel it will
'not be shown on the screen.
'I you want to show it then
'Excel.Visible = True ' Show Excel
Exit Sub
err:
Set Excel = CreateObject("Excel.Application") 'Create Excel Object.
End Sub
Private Sub CreateWorkSheetS()
l5.Caption = "Creating Excel Worksheet"
Set ExcelWBk = Excel.Workbooks.Open(App.Path & "\dummy.xls") 'Add this Workbook to Excel.
Set ExcelWS = ExcelWBk.Sheets(3) 'ActiveSheet ' Add this sheet to this Workbook
End Sub
Private Sub PopulateWorkSheetS()
Dim row As Integer
Dim temp As String
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyCode <> 4 And ModeOfPayment = 1 Order By UtilityCompanyCode", cn, adOpenKeyset, adLockOptimistic
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.Open "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fields(4).Value, cn, adOpenKeyset, adLockOptimistic
If rsCompanyName.RecordCount > 0 Then
ExcelWS.Cells(row, 2) = rsAllInOne.Fields(5).Value
ExcelWS.Cells(row, 3) = rsCompanyName.Fields(1).Value
ExcelWS.Cells(row, 4) = rsAllInOne.Fields(7).Value
ExcelWS.Cells(row, 5) = rsAllInOne.Fields(1).Value
ExcelWS.Cells(row, 6) = rsAllInOne.Fields(12).Value
ExcelWS.Cells(row, 7) = rsAllInOne.Fields(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.MoveNext
rsCompanyName.Close
Wend
rsAllInOne.Close
Set ExcelWS = ExcelWBk.Sheets(4)
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyCode <> 4 And ModeOfPayment = 2", cn, adOpenKeyset, adLockOptimistic
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.Open "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fields(4).Value, cn, adOpenKeyset, adLockOptimistic
If rsCompanyName.RecordCount > 0 Then
ExcelWS.Cells(row, 3) = rsAllInOne.Fields(5).Value
ExcelWS.Cells(row, 4) = rsCompanyName.Fields(1).Value
ExcelWS.Cells(row, 6) = rsAllInOne.Fields(7).Value
ExcelWS.Cells(row, 7) = rsAllInOne.Fields(1).Value
ExcelWS.Cells(row, 8) = rsAllInOne.Fields(12).Value
ExcelWS.Cells(row, 9) = rsAllInOne.Fields(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.MoveNext
rsCompanyName.Close
Wend
rsAllInOne.Close
Set ExcelWS = ExcelWBk.Sheets(5)
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyCode = 4 And ModeOfPayment = 1", cn, adOpenKeyset, adLockOptimistic
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.Open "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fields(4).Value, cn, adOpenKeyset, adLockOptimistic
If rsCompanyName.RecordCount > 0 Then
ExcelWS.Cells(row, 2) = rsAllInOne.Fields(5).Value
ExcelWS.Cells(row, 3) = rsCompanyName.Fields(1).Value
ExcelWS.Cells(row, 4) = rsAllInOne.Fields(7).Value
ExcelWS.Cells(row, 5) = rsAllInOne.Fields(1).Value
ExcelWS.Cells(row, 6) = rsAllInOne.Fields(12).Value
ExcelWS.Cells(row, 7) = rsAllInOne.Fields(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.MoveNext
rsCompanyName.Close
Wend
rsAllInOne.Close
Set ExcelWS = ExcelWBk.Sheets(6)
row = 8 ' This is the row, start from 2nd row bec 1st row is header.
rsAllInOne.Open "SELECT * From BillData Where UtilityCompanyCode = 4 And ModeOfPayment = 2", cn, adOpenKeyset, adLockOptimistic
While rsAllInOne.EOF <> True ' populate with first 100 records
'Total field is 12 so
rsCompanyName.Open "Select * from CompanyName Where CompanyID = " & rsAllInOne.Fields(4).Value, cn, adOpenKeyset, adLockOptimistic
If rsCompanyName.RecordCount > 0 Then
ExcelWS.Cells(row, 3) = rsAllInOne.Fields(5).Value
'ExcelWS.Cells(row, 4) = rsCompanyName.Fields(1).Value
ExcelWS.Cells(row, 5) = rsAllInOne.Fields(7).Value
ExcelWS.Cells(row, 6) = rsAllInOne.Fields(1).Value
ExcelWS.Cells(row, 7) = rsAllInOne.Fields(12).Value
ExcelWS.Cells(row, 8) = rsAllInOne.Fields(2).Value
row = row + 1 ' increment row
l5.Caption = "Adding Records Please Wait: " & row & " records added"
End If
rsAllInOne.MoveNext
rsCompanyName.Close
Wend
rsAllInOne.Close
End Sub
Private Sub SaveWorkSheetS()
' Save the workbook on the desktop
'I didn't had time so I have not added export feature.
'If you want to export it into another format then just
'change this line.
'e.g
'ExcelWBk.SaveAs "c:\windows\desktop\Demo.txt", xlCSV
l5.Caption = "Saving Excel"
ExcelWBk.SaveAs App.Path & "\" & Text1.Text & Mid(Time, 7, 2) & "final.xls"
'text1.Text = ""
End Sub
Private Sub CloseWorkSheetS()
' Close the WorkBook
ExcelWBk.Close
' Quit Excel app
Excel.Quit
l5.Caption = ""
'Text1.Text = ""
MsgBox "You can find the saved Excel Sheet at " & App.Path, vbInformation + vbOKOnly
End Sub
I have a Project at hand "Importing Excel files into a VBA" but i dont know how to go about it. Please can someone put me through. Though i tried Importing wizard but am not getting the result i wanted. Please what do u suggest.
3
